Produced by Araxis Merge on 4/16/2019 12:20:47 PM Central Daylight Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.
# | Location | File | Last Modified |
---|---|---|---|
1 | C:\AraxisMergeCompare\Pri_un\CPRS_32_P2_PCE\OR_30_405V60_SRC | fFrame.pas | Wed Dec 12 14:04:36 2018 UTC |
2 | C:\AraxisMergeCompare\Pri_re\CPRS v32 P2 PCE Standardization-redacted\CPRS_32_P2_PCE\OR_30_405V60_SRC | fFrame.pas | Tue Apr 16 15:14:56 2019 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 3 | 10928 |
Changed | 2 | 4 |
Inserted | 0 | 0 |
Removed | 0 | 0 |
Whitespace | |
---|---|
Character case | Differences in character case are significant |
Line endings | Differences in line endings (CR and LF characters) are ignored |
CR/LF characters | Not shown in the comparison detail |
No regular expressions were active.
1 | unit fFram e; | |
2 | { This is the main f orm for th e CPRS GUI . It prov ides a pat ient-encou nter-user framework | |
3 | which al l the othe r forms of the GUI u se. } | |
4 | ||
5 | {$OPTIMIZA TION OFF} / / REMOVE A FTER UNIT IS DEBUGGE D | |
6 | {$WARN SYM BOL_PLATFO RM OFF} | |
7 | {$DEFINE C COWBROKER} | |
8 | ||
9 | {$undef de bug} | |
10 | ||
11 | interface | |
12 | ||
13 | uses | |
14 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dia logs, Tabs , ComCtrls , | |
15 | ExtCtrls , Menus, S tdCtrls, B uttons, OR Fn, fPage, uConst, O RCtrls, Tr pcb, Contn rs, | |
16 | OleCtrls , VERGENCE CONTEXTORL ib_TLB, Co mObj, AppE vnts, fBas e508Form, oPKIEncryp tion, | |
17 | VA508Acc essibility Manager, R ichEdit, f DebugRepor t, StrUtil s, vcl.Act nList, | |
18 | System.S yncObjs, U _CPTAppMon itor, ORNe tIntf; | |
19 | ||
20 | type | |
21 | TfrmFram e = class( TfrmBase50 8Form) | |
22 | pnlToo lbar: TPan el; | |
23 | stsAre a: TStatus Bar; | |
24 | tabPag e: TTabCon trol; | |
25 | pnlPag e: TPanel; | |
26 | bvlPag eTop: TBev el; | |
27 | bvlToo lTop: TBev el; | |
28 | pnlPat ient: TKey ClickPanel ; | |
29 | lblPtN ame: TStat icText; | |
30 | lblPtS SN: TStati cText; | |
31 | lblPtA ge: TStati cText; | |
32 | pnlVis it: TKeyCl ickPanel; | |
33 | lblPtL ocation: T StaticText ; | |
34 | lblPtP rovider: T StaticText ; | |
35 | mnuFra me: TMainM enu; | |
36 | mnuFil e: TMenuIt em; | |
37 | mnuFil eExit: TMe nuItem; | |
38 | mnuFil eOpen: TMe nuItem; | |
39 | mnuFil eReview: T MenuItem; | |
40 | Z1: TM enuItem; | |
41 | mnuFil ePrint: TM enuItem; | |
42 | mnuEdi t: TMenuIt em; | |
43 | mnuEdi tUndo: TMe nuItem; | |
44 | Z3: TM enuItem; | |
45 | mnuEdi tCut: TMen uItem; | |
46 | mnuEdi tCopy: TMe nuItem; | |
47 | mnuEdi tPaste: TM enuItem; | |
48 | Z4: TM enuItem; | |
49 | mnuEdi tPref: TMe nuItem; | |
50 | Prefs1 : TMenuIte m; | |
51 | mnu14p t1: TMenuI tem; | |
52 | mnu12p t1: TMenuI tem; | |
53 | mnu10p t1: TMenuI tem; | |
54 | mnu8pt : TMenuIte m; | |
55 | mnuHel p: TMenuIt em; | |
56 | mnuHel pContents: TMenuItem ; | |
57 | mnuHel pTutor: TM enuItem; | |
58 | Z5: TM enuItem; | |
59 | mnuHel pAbout: TM enuItem; | |
60 | mnuToo ls: TMenuI tem; | |
61 | mnuVie w: TMenuIt em; | |
62 | mnuVie wChart: TM enuItem; | |
63 | mnuCha rtReports: TMenuItem ; | |
64 | mnuCha rtLabs: TM enuItem; | |
65 | mnuCha rtDCSumm: TMenuItem; | |
66 | mnuCha rtCslts: T MenuItem; | |
67 | mnuCha rtNotes: T MenuItem; | |
68 | mnuCha rtOrders: TMenuItem; | |
69 | mnuCha rtMeds: TM enuItem; | |
70 | mnuCha rtProbs: T MenuItem; | |
71 | mnuCha rtCover: T MenuItem; | |
72 | mnuHel pBroker: T MenuItem; | |
73 | mnuFil eEncounter : TMenuIte m; | |
74 | mnuVie wDemo: TMe nuItem; | |
75 | mnuVie wPostings: TMenuItem ; | |
76 | mnuHel pLists: TM enuItem; | |
77 | Z6: TM enuItem; | |
78 | mnuHel pSymbols: TMenuItem; | |
79 | mnuFil eNext: TMe nuItem; | |
80 | Z7: TM enuItem; | |
81 | mnuFil eRefresh: TMenuItem; | |
82 | pnlPri maryCare: TKeyClickP anel; | |
83 | lblPtC are: TStat icText; | |
84 | lblPtA ttending: TStaticTex t; | |
85 | pnlRem inders: TK eyClickPan el; | |
86 | imgRem inder: TIm age; | |
87 | mnuVie wReminders : TMenuIte m; | |
88 | anmtRe mSearch: T Animate; | |
89 | lstCIR NLocations : TORListB ox; | |
90 | popCIR N: TPopupM enu; | |
91 | popCIR NSelectAll : TMenuIte m; | |
92 | popCIR NSelectNon e: TMenuIt em; | |
93 | popCIR NClose: TM enuItem; | |
94 | mnuFil ePrintSetu p: TMenuIt em; | |
95 | LabInf o1: TMenuI tem; | |
96 | mnuFil eNotifRemo ve: TMenuI tem; | |
97 | Z8: TM enuItem; | |
98 | mnuToo lsOptions: TMenuItem ; | |
99 | mnuCha rtSurgery: TMenuItem ; | |
100 | OROpen Dlg: TOpen Dialog; | |
101 | mnuFil eResumeCon text: TMen uItem; | |
102 | mnuFil eResumeCon textSet: T MenuItem; | |
103 | Useexi stingconte xt1: TMenu Item; | |
104 | mnuFil eBreakCont ext: TMenu Item; | |
105 | pnlCCO W: TPanel; | |
106 | imgCCO W: TImage; | |
107 | pnlPat ientSelect ed: TPanel ; | |
108 | pnlNoP atientSele cted: TPan el; | |
109 | pnlPos tings: TKe yClickPane l; | |
110 | lblPtP ostings: T StaticText ; | |
111 | lblPtC WAD: TStat icText; | |
112 | mnuFil ePrintSele ctedItems: TMenuItem ; | |
113 | popAle rts: TPopu pMenu; | |
114 | mnuAle rtContinue : TMenuIte m; | |
115 | mnuAle rtForward: TMenuItem ; | |
116 | mnuAle rtRenew: T MenuItem; | |
117 | AppEve nts: TAppl icationEve nts; | |
118 | paVAA: TKeyClick Panel; | |
119 | mnuToo lsGraphing : TMenuIte m; | |
120 | laVAA2 : TButton; | |
121 | laMHV: TButton; | |
122 | mnuVie wInformati on: TMenuI tem; | |
123 | mnuVie wVisits: T MenuItem; | |
124 | mnuVie wPrimaryCa re: TMenuI tem; | |
125 | mnuVie wMyHealthe Vet: TMenu Item; | |
126 | mnuIns urance: TM enuItem; | |
127 | mnuVie wFlags: TM enuItem; | |
128 | mnuVie wRemoteDat a: TMenuIt em; | |
129 | compAc cessTabPag e: TVA508C omponentAc cessibilit y; | |
130 | pnlCVn Flag: TPan el; | |
131 | btnCom batVet: TB utton; | |
132 | pnlFla g: TKeyCli ckPanel; | |
133 | lblFla g: TLabel; | |
134 | pnlRem oteData: T KeyClickPa nel; | |
135 | pnlVis taWeb: TKe yClickPane l; | |
136 | lblVis taWeb: TLa bel; | |
137 | pnlCIR N: TKeyCli ckPanel; | |
138 | lblCIR N: TLabel; | |
139 | mnuEdi tRedo: TMe nuItem; | |
140 | lblPtM HTC: TStat icText; | |
141 | Digita lSigningSe tup1: TMen uItem; | |
142 | mnuFoc usChanges: TMenuItem ; | |
143 | txtCmd Flags: TVA 508StaticT ext; | |
144 | mnuFil eViewNotif ications: TMenuItem; | |
145 | CPAppM on: TCopyA pplication Monitor; | |
146 | pnlOTH D: TKeyCli ckPanel; | |
147 | lblOTH D: TStatic Text; | |
148 | lblOTH DTitle: TS taticText; // rpk 1 1/28/2017 | |
149 | proced ure tabPag eChange(Se nder: TObj ect); | |
150 | proced ure FormCr eate(Sende r: TObject ); | |
151 | proced ure FormRe size(Sende r: TObject ); | |
152 | proced ure pnlPat ientMouseD own(Sender : TObject; Button: T MouseButto n; | |
153 | Shif t: TShiftS tate; X, Y : Integer) ; | |
154 | proced ure pnlPat ientMouseU p(Sender: TObject; B utton: TMo useButton; | |
155 | Shif t: TShiftS tate; X, Y : Integer) ; | |
156 | proced ure pnlVis itMouseDow n(Sender: TObject; B utton: TMo useButton; | |
157 | Shif t: TShiftS tate; X, Y : Integer) ; | |
158 | proced ure pnlVis itMouseUp( Sender: TO bject; But ton: TMous eButton; | |
159 | Shif t: TShiftS tate; X, Y : Integer) ; | |
160 | proced ure mnuFil eExitClick (Sender: T Object); | |
161 | proced ure pnlPos tingsMouse Down(Sende r: TObject ; Button: TMouseButt on; | |
162 | Shif t: TShiftS tate; X, Y : Integer) ; | |
163 | proced ure pnlPos tingsMouse Up(Sender: TObject; Button: TM ouseButton ; | |
164 | Shif t: TShiftS tate; X, Y : Integer) ; | |
165 | proced ure mnuFon tSizeClick (Sender: T Object); | |
166 | proced ure mnuCha rtTabClick (Sender: T Object); | |
167 | proced ure FormDe stroy(Send er: TObjec t); | |
168 | proced ure mnuFil eOpenClick (Sender: T Object); | |
169 | proced ure mnuHel pBrokerCli ck(Sender: TObject); | |
170 | proced ure mnuFil eEncounter Click(Send er: TObjec t); | |
171 | proced ure mnuVie wPostingsC lick(Sende r: TObject ); | |
172 | proced ure mnuHel pAboutClic k(Sender: TObject); | |
173 | proced ure mnuFil eReviewCli ck(Sender: TObject); | |
174 | proced ure FormCl oseQuery(S ender: TOb ject; var CanClose: Boolean); | |
175 | proced ure mnuHel pListsClic k(Sender: TObject); | |
176 | proced ure ToolCl ick(Sender : TObject) ; | |
177 | proced ure mnuEdi tClick(Sen der: TObje ct); | |
178 | proced ure mnuEdi tUndoClick (Sender: T Object); | |
179 | proced ure mnuEdi tCutClick( Sender: TO bject); | |
180 | proced ure mnuEdi tCopyClick (Sender: T Object); | |
181 | proced ure mnuEdi tPasteClic k(Sender: TObject); | |
182 | proced ure mnuHel pSymbolsCl ick(Sender : TObject) ; | |
183 | proced ure FormCl ose(Sender : TObject; var Actio n: TCloseA ction); | |
184 | proced ure mnuFil ePrintClic k(Sender: TObject); | |
185 | proced ure mnuGEC StatusClic k(Sender: TObject); | |
186 | proced ure mnuFil eNextClick (Sender: T Object); | |
187 | proced ure pnlPri maryCareMo useDown(Se nder: TObj ect; | |
188 | Butt on: TMouse Button; Sh ift: TShif tState; X, Y: Intege r); | |
189 | proced ure pnlPri maryCareMo useUp(Send er: TObjec t; Button: TMouseBut ton; | |
190 | Shif t: TShiftS tate; X, Y : Integer) ; | |
191 | proced ure pnlRem indersMous eDown(Send er: TObjec t; Button: TMouseBut ton; | |
192 | Shif t: TShiftS tate; X, Y : Integer) ; | |
193 | proced ure pnlRem indersMous eUp(Sender : TObject; Button: T MouseButto n; | |
194 | Shif t: TShiftS tate; X, Y : Integer) ; | |
195 | proced ure pnlCIR NClick(Sen der: TObje ct); | |
196 | proced ure lstCIR NLocations Click(Send er: TObjec t); | |
197 | proced ure popCIR NCloseClic k(Sender: TObject); | |
198 | proced ure popCIR NSelectAll Click(Send er: TObjec t); | |
199 | proced ure popCIR NSelectNon eClick(Sen der: TObje ct); | |
200 | proced ure mnuFil ePrintSetu pClick(Sen der: TObje ct); | |
201 | proced ure LabInf o1Click(Se nder: TObj ect); | |
202 | proced ure mnuFil eNotifRemo veClick(Se nder: TObj ect); | |
203 | proced ure mnuToo lsOptionsC lick(Sende r: TObject ); | |
204 | proced ure mnuFil eRefreshCl ick(Sender : TObject) ; | |
205 | proced ure FormKe yDown(Send er: TObjec t; var Key : Word; | |
206 | Shif t: TShiftS tate); | |
207 | proced ure FormAc tivate(Sen der: TObje ct); | |
208 | proced ure pnlPri maryCareEn ter(Sender : TObject) ; | |
209 | proced ure pnlPri maryCareEx it(Sender: TObject); | |
210 | proced ure pnlPat ientClick( Sender: TO bject); | |
211 | proced ure pnlVis itClick(Se nder: TObj ect); | |
212 | proced ure pnlPri maryCareCl ick(Sender : TObject) ; | |
213 | proced ure pnlRem indersClic k(Sender: TObject); | |
214 | proced ure pnlPos tingsClick (Sender: T Object); | |
215 | proced ure ctxCon textorCanc eled(Sende r: TObject ); | |
216 | proced ure ctxCon textorComm itted(Send er: TObjec t); | |
217 | proced ure ctxCon textorPend ing(Sender : TObject; | |
218 | cons t aContext ItemCollec tion: IDis patch); | |
219 | proced ure mnuDeb ugReportCl ick(Sender : TObject) ; | |
220 | proced ure mnuFil eBreakCont extClick(S ender: TOb ject); | |
221 | proced ure mnuFil eResumeCon textGetCli ck(Sender: TObject); | |
222 | proced ure mnuFil eResumeCon textSetCli ck(Sender: TObject); | |
223 | proced ure pnlFla gMouseDown (Sender: T Object; Bu tton: TMou seButton; | |
224 | Shif t: TShiftS tate; X, Y : Integer) ; | |
225 | proced ure pnlFla gMouseUp(S ender: TOb ject; Butt on: TMouse Button; | |
226 | Shif t: TShiftS tate; X, Y : Integer) ; | |
227 | proced ure pnlFla gClick(Sen der: TObje ct); | |
228 | proced ure mnuFil ePrintSele ctedItemsC lick(Sende r: TObject ); | |
229 | proced ure mnuAle rtRenewCli ck(Sender: TObject); | |
230 | proced ure mnuAle rtForwardC lick(Sende r: TObject ); | |
231 | proced ure pnlFla gEnter(Sen der: TObje ct); | |
232 | proced ure pnlFla gExit(Send er: TObjec t); | |
233 | proced ure tabPag eMouseUp(S ender: TOb ject; Butt on: TMouse Button; | |
234 | Shif t: TShiftS tate; X, Y : Integer) ; | |
235 | proced ure lstCIR NLocations Exit(Sende r: TObject ); | |
236 | proced ure AppEve ntsActivat e(Sender: TObject); | |
237 | proced ure Screen ActiveForm Change(Sen der: TObje ct); | |
238 | proced ure AppEve ntsShortCu t(var Msg: TWMKey; v ar Handled : Boolean) ; | |
239 | proced ure mnuToo lsGraphing Click(Send er: TObjec t); | |
240 | proced ure pnlCIR NMouseDown (Sender: T Object; Bu tton: TMou seButton; | |
241 | Shif t: TShiftS tate; X, Y : Integer) ; | |
242 | proced ure pnlCIR NMouseUp(S ender: TOb ject; Butt on: TMouse Button; | |
243 | Shif t: TShiftS tate; X, Y : Integer) ; | |
244 | proced ure laMHVC lick(Sende r: TObject ); | |
245 | proced ure laVAA2 Click(Send er: TObjec t); | |
246 | proced ure ViewIn fo(Sender: TObject); | |
247 | proced ure mnuVie wInformati onClick(Se nder: TObj ect); | |
248 | proced ure compAc cessTabPag eCaptionQu ery(Sender : TObject; | |
249 | var Text: stri ng); | |
250 | proced ure btnCom batVetClic k(Sender: TObject); | |
251 | proced ure pnlVis taWebClick (Sender: T Object); | |
252 | proced ure pnlVis taWebMouse Up(Sender: TObject; Button: TM ouseButton ; | |
253 | Shif t: TShiftS tate; X, Y : Integer) ; | |
254 | proced ure pnlVis taWebMouse Down(Sende r: TObject ; Button: TMouseButt on; | |
255 | Shif t: TShiftS tate; X, Y : Integer) ; | |
256 | proced ure mnuEdi tRedoClick (Sender: T Object); | |
257 | proced ure tabPag eMouseDown (Sender: T Object; Bu tton: TMou seButton; | |
258 | Shif t: TShiftS tate; X, Y : Integer) ; | |
259 | proced ure Digita lSigningSe tup1Click( Sender: TO bject); | |
260 | proced ure mnuFoc usChangesC lick(Sende r: TObject ); | |
261 | proced ure AppEve ntsMessage (var Msg: tagMSG; va r Handled: Boolean); | |
262 | proced ure mnuFil eViewNotif icationsCl ick(Sender : TObject) ; | |
263 | proced ure paVAAR esize(Send er: TObjec t); | |
264 | proced ure LoadBu ffer(Sende r: TObject ; LoadList : TStrings ; var Proc essLoad: B oolean); | |
265 | proced ure LoadPr operties(S ender: TOb ject); | |
266 | proced ure SaveBu ffer(Sende r: TObject ; SaveList : TStringL ist; var R eturnList: TStringLi st); | |
267 | proced ure StartP ollBuff(Se nder: TObj ect; var E rror: Bool ean); | |
268 | proced ure StopPo llBuff(Sen der: TObje ct; var Er ror: Boole an); | |
269 | proced ure pnlOTH DEnter(Sen der: TObje ct); // rp k 1/5/2018 | |
270 | proced ure pnlOTH DExit(Send er: TObjec t); // rp k 1/5/2018 | |
271 | proced ure pnlOTH DClick(Sen der: TObje ct); // r pk 1/5/201 8 | |
272 | proced ure lblOTH DClick(Sen der: TObje ct); // rpk 1/5/20 18 | |
273 | proced ure lblOTH DTitleClic k(Sender: TObject); | |
274 | private | |
275 | FProcc essingNext Click : bo olean; | |
276 | FJustE nteredApp : boolean; | |
277 | FCCOWI nstalled: boolean; | |
278 | FCCOWC ontextChan ging: bool ean; | |
279 | FCCOWI conName: s tring; | |
280 | FCCOWD rivedChang e: boolean ; | |
281 | FCCOWB usy: boole an; | |
282 | FCCOWE rror: bool ean; | |
283 | FCCOWJ ustJoined: boolean; | |
284 | FNoPat ientSelect ed: boolea n; | |
285 | FRefre shing: boo lean; | |
286 | FClosi ng: boolea n; | |
287 | FConte xtChanging : Boolean; | |
288 | FChang eSource: I nteger; | |
289 | FCreat eProgress: Integer; | |
290 | FEditC trl: TCust omEdit; | |
291 | FLastP age: TForm ; | |
292 | FNextB uttonL: In teger; | |
293 | FNextB uttonR: In teger; | |
294 | FNextB uttonActiv e: Boolean ; | |
295 | FNextB uttonBitma p: TBitmap ; | |
296 | FNextB utton: TBi tBtn; | |
297 | FTermi nate: Bool ean; | |
298 | FTabCh anged: TNo tifyEvent; | |
299 | FOldAc tivate: TN otifyEvent ; | |
300 | FOldAc tiveFormCh ange: TNot ifyEvent; | |
301 | FECSAu thUser: Bo olean; | |
302 | FFixed StatusWidt h: integer ; | |
303 | FPrevI nPatient: Boolean; | |
304 | FFirst Load: B oolean; | |
305 | FFlagL ist: TStri ngList; | |
306 | FPrevP tID: strin g; | |
307 | FGraph FloatActiv e: boolean ; | |
308 | FGraph Context: s tring; | |
309 | FDoNot ChangeEncW indow: boo lean; | |
310 | FOrder PrintForm: boolean; | |
311 | FRevie wclick: bo olean; | |
312 | FCtrlT abUsed: bo olean; | |
313 | proced ure Refres hFixedStat usWidth; | |
314 | proced ure FocusA pplication TopForm; | |
315 | proced ure AppAct ivated(Sen der: TObje ct); | |
316 | proced ure AppDeA ctivated(S ender: TOb ject); | |
317 | proced ure AppExc eption(Sen der: TObje ct; E: Exc eption); | |
318 | functi on AllowCo ntextChang eAll(var R eason: str ing): Boo lean; | |
319 | proced ure ClearP atient; | |
320 | proced ure Change Font(NewFo ntSize: In teger); | |
321 | proced ure Create Tab(ATabID : integer; ALabel: s tring); | |
322 | proced ure Determ ineNextTab ; | |
323 | functi on ExpandC ommand(x: string): s tring; | |
324 | proced ure FitToo lbar; | |
325 | proced ure LoadSi zesForUser ; | |
326 | proced ure SaveSi zesForUser ; | |
327 | proced ure LoadUs erPreferen ces; | |
328 | proced ure SaveUs erPreferen ces; | |
329 | proced ure Switch ToPage(New Form: TFor m); | |
330 | functi on TabToPa geID(Tab: Integer): Integer; | |
331 | functi on Timeout Condition: boolean; | |
332 | functi on GetTime dOut: bool ean; | |
333 | proced ure TimeOu tAction; | |
334 | proced ure SetUse rTools; | |
335 | proced ure SetDeb ugMenu; | |
336 | proced ure SetupP atient(AFl aggedList : TStringL ist = nil) ; | |
337 | proced ure Remind ersChanged (Sender: T Object); | |
338 | proced ure Report sOnlyDispl ay; | |
339 | proced ure UMInit iate(var M essage: TM essage); message U M_INITIATE ; | |
340 | proced ure UMNewO rder(var M essage: TM essage); message U M_NEWORDER ; | |
341 | proced ure UMRemi nders(var Message: T Message); message U M_REMINDER S; | |
342 | proced ure UMStat usText(var Message: TMessage); message U M_STATUSTE XT; | |
343 | proced ure UMShow Page(var M essage: TM essage); message U M_SHOWPAGE ; | |
344 | proced ure WMSetF ocus(var M essage: TM essage); message W M_SETFOCUS ; | |
345 | proced ure WMSysC ommand(var Message: TMessage); message W M_SYSCOMMA ND; | |
346 | proced ure UMEncU pd(var Mes sage: TMes sage); message U M_ENCUPD;/ / PaPI === | |
347 | proced ure UMPAPI (var Messa ge: TMessa ge); messa ge UM_PAPI ; // PaPI Test | |
348 | proced ure Update ECSParamet er(var Cmd Parameter: string); | |
349 | functi on ValidE CSUser: bo olean; | |
350 | proced ure StartC COWContext or; | |
351 | functi on AllowC COWContext Change(var CCOWRespo nse: UserR esponse; N ewDFN: str ing): bool ean; | |
352 | proced ure Update CCOWContex t; | |
353 | proced ure CheckH yperlinkRe sponse(aCo ntextItemC ollection: IDispatch ; var Hype rlinkReaso n: string) ; | |
354 | proced ure CheckF orDifferen tPatient(a ContextIte mCollectio n: IDispat ch; var Pt Changed: b oolean); | |
355 | {$IFDEF CC OWBROKER} | |
356 | proced ure CheckF orDifferen tUser(aCon textItemCo llection: IDispatch; var UserC hanged: bo olean); | |
357 | {$ENDIF} | |
358 | proced ure HideEv erything(A Message: s tring = 'N o patient is current ly selecte d.'); | |
359 | proced ure ShowEv erything; | |
360 | functi on FindBes tCCOWDFN: string; | |
361 | proced ure Handle CCOWError( AMessage: string); | |
362 | proced ure SetUpN extButton; | |
363 | proced ure NextBu ttonClick( Sender: TO bject); | |
364 | proced ure NextBu ttonMouseD own(Sender : TObject; Button: T MouseButto n; | |
365 | Shif t: TShiftS tate; X, Y : Integer) ; | |
366 | proced ure ModalE nd(Sender: TObject); | |
367 | Proced ure GetExc ludedFromM ixed(); | |
368 | public | |
369 | Enduri ngPtSelSpl itterPos, frmFrameHe ight, pnlP atientSele ctedHeight : integer; | |
370 | Enduri ngPtSelCol umns: stri ng; | |
371 | proced ure SetBAD xList; | |
372 | proced ure SetAct iveTab(Pag eID: Integ er); | |
373 | proced ure Refres hCWAD(Send er: TObjec t); // TDr ugs Patch OR*3*377 a nd WV*1*24 - DanP@SL C 11-20-20 15 | |
374 | proced ure Update VAAMHVButt ons(Sender : TObject) ; // TDrug s Patch OR *3*377 and WV*1*24 - DanP@SLC 01-02-2016 | |
375 | ||
376 | functi on PageIDT oTab(PageI D: Integer ): Integer ; | |
377 | proced ure ShowHi deChartTab Menus(AMen uItem: TMe nuItem); | |
378 | proced ure Update PtInfoOnRe fresh; | |
379 | functi on TabExi sts(ATabID : integer) : boolean; | |
380 | proced ure Displa yEncounter Text; | |
381 | functi on DLLActi ve: boolea n; | |
382 | proper ty ChangeS ource: Integer re ad FChange Source; | |
383 | proper ty CCOWCon textChangi ng: Boolea n read FCC OWContextC hanging; | |
384 | proper ty CCOWDri vedChange: Boolean read FCCOW DrivedChan ge; | |
385 | proper ty CCOWBus y: Boolean read F CCOWBusy write FCCO WBusy; | |
386 | proper ty Context Changing: Boolean re ad FContex tChanging; | |
387 | proper ty TimedOu t: Boolean re ad GetTime dOut; | |
388 | proper ty Closing : Boolean re ad FClosin g; | |
389 | proper ty OnTabCh anged: TNotifyEve nt read FT abChanged write FTab Changed; | |
390 | proper ty GraphFl oatActive: boolean r ead FGraph FloatActiv e write FG raphFloatA ctive; | |
391 | proper ty GraphCo ntext: str ing read F GraphConte xt write F GraphConte xt; | |
392 | proced ure Toggle MenuItemCh ecked(Send er: TObjec t); | |
393 | proced ure SetUpC IRN; | |
394 | proper ty DoNotCh angeEncWin dow: boole an read FD oNotChange EncWindow write FDoN otChangeEn cWindow; | |
395 | proper ty OrderPr intForm: b oolean rea d FOrderPr intForm wr ite FOrder PrintForm; | |
396 | end; | |
397 | ||
398 | TRpcReco rd = recor d | |
399 | RpcNam e: String; | |
400 | UCallL istIndex: Integer; | |
401 | Result ListIndex: Integer; | |
402 | Search Index: Int eger; | |
403 | RPCTex t: TString List; | |
404 | RPCRun Time: stri ng; | |
405 | end; | |
406 | ||
407 | var | |
408 | frmFrame : TfrmFram e; | |
409 | uTabList : TStringL ist; | |
410 | uLabRemo teType, uR emoteType, uReportID , uLabRepI D : string ; | |
411 | FlaggedP TList: TSt ringList; | |
412 | ctxConte xtor : TCo ntextorCon trol; | |
413 | NextTab, LastTab, ChangingTa b: Integer ; | |
414 | uUseVist aWeb: bool ean; | |
415 | PTSwitch Refresh: b oolean = F alse; //f lag for pa tient refr esh or swi tch of pat ients | |
416 | ProbTabC licked: bo olean = FA LSE; | |
417 | TabCtrlC licked: Bo olean = FA LSE; | |
418 | DEAConte xt: Boolea n = False; | |
419 | DelayRev iewChanges : Boolean = False; | |
420 | WatchArr ay: Array of TRpcRec ord; | |
421 | ||
422 | const | |
423 | PASSCODE = '_gghwn 7pghCrOJvO V61PtPvgde EU2u5cRsGv pkVDjKT_H7 SdKE_hqFYW sUIVT1H7Jw T6Yz8oCtd2 u2PALqWxib NXx3Yo8GPc TYsNaxW' + 'ZFo8OgT1 1D5TIvpu3c DQuZd3Yh_n V9jhkvb0ZB GdO9n-uNXP PEK7xfYWCI 2Wp3Dsu9YD Sd_EM34nvr gy64cqu9_j FJKJnGiXY9 6Lf1ecLiv4 LT9qtmJ-Ba wYt7O9JZGA swi344BmmC bNxfgvgf0g fGZea'; | |
424 | EM_SETZO OM = (WM_U SER + 225) ; | |
425 | implementa tion | |
426 | ||
427 | {$R *.DFM} | |
428 | {$R sBitma ps} | |
429 | {$R sRemSr ch} | |
430 | ||
431 | uses | |
432 | ORNet, r Core, fPtS elMsg, fPt Sel, fCove rSheet, fP robs, fMed s, fOrders , rOrders, fNotes, f Consults, fDCSumm, | |
433 | rMisc, C lipbrd, fL abs, fRepo rts, rRepo rts, fPtDe mo, fEncnt , fPtCWAD, uCore, fA bout, fRev iew, | |
434 | // fxBrok er, - repl aced with fGN_RPCLog | |
435 | uGN_RPCL og, | |
436 | fxLists, | |
437 | // fxServ er, | |
438 | ORSystem , fRptBox, fSplash, rODAllergy , uInit, f LabTests, fLabInfo, uGlobalVar , | |
439 | uReminde rs, fRemin derTree, O RClasses, fDeviceSel ect, fDraw ers, fRemi nderDialog , ShellAPI , rVitals, | |
440 | fOptions , fGraphs, fGraphDat a, rTempla tes, fSurg ery, rSurg ery, uEven tHooks, uS ignItems, | |
441 | fDefault Event, rEC S, fIconLe gend, uOrd ers, fPtSe lOptns, Da teUtils, u Spell, uOr Ptf, fPati entFlagMul ti, | |
442 | fAlertFo rward, UBA Globals, f BAOptionsD iagnoses, UBACore, f OrdersSign , uVitals, fOrdersRe new, fMHTe st, uFormM onitor | |
443 | {$IFDEF CCOWBROKER } | |
444 | , CCOW_c onst | |
445 | {$ENDIF} | |
446 | , VA508A ccessibili tyRouter, fOtherSche dule, VAUt ils, uVA50 8CPRSCompa tibility, fIVRoutes, | |
447 | fPrintLo cation, fT emplateEdi tor, fTemp lateDialog , fCombatV et, fFocus edControls , | |
448 | fViewNot ifications , uPaPI, i CoverSheet Intf, AVCa tcher, Sys tem.IniFil es; | |
449 | ||
450 | //PaPI === ========== ========== ========== ========== ========== ========== ========== | |
451 | procedure SwitchToTh isWindow(h 1: hWnd; x : bool); s tdcall; | |
452 | external user32 Na me 'Switch ToThisWind ow'; | |
453 | { x = false: Size unch anged, x = true: nor mal size} | |
454 | //PaPI === ========== ========== ========== ========== ========== ========== ========== | |
455 | ||
456 | var | |
457 | IsRunExe cuted: Boo lean = FAL SE; | |
458 | GraphFlo at: TfrmGr aphs; | |
459 | OTHDShor tStr, | |
460 | OTHDLong Str1, OTHD LongStr2, | |
461 | OTHDLoca lMsg: Stri ng; // rpk 2/28/2018 | |
462 | const | |
463 | FCP_UPDA TE = 10; // form crea te about t o check au to-update | |
464 | FCP_SETH OOK = 20; // form crea te about t o set time out hooks | |
465 | FCP_SERV ER = 30; // form crea te about t o connect to server | |
466 | FCP_CHKV ER = 40; // form crea te about t o check ve rsion | |
467 | FCP_OBJE CTS = 50; // form crea te about t o create c ore object s | |
468 | FCP_FORM S = 60; // form crea te about t o create c hild forms | |
469 | FCP_PTSE L = 70; // form crea te about t o select p atient | |
470 | FCP_FINI SH = 99; // form crea te finishe d successf ully | |
471 | ||
472 | TX_IN_US E = 'V istA CPRS in use by: '; // use same as with CP RSInstance s in fTime out | |
473 | TX_OPTIO N = 'O R CPRS GUI CHART'; | |
474 | TX_ECSOP T = 'E C GUI CONT EXT'; | |
475 | TX_PTINQ = 'R etrieving demographi c informat ion...'; | |
476 | TX_NOTIF _STOP = 'S top proces sing notif ications?' ; | |
477 | TC_NOTIF _STOP = 'C urrently P rocessing Notificati ons'; | |
478 | TX_UNK_N OTIF = 'U nable to p rocess the follow up action fo r this not ification' ; | |
479 | TC_UNK_N OTIF = 'F ollow Up A ction Not Implemente d'; | |
480 | TX_NO_SU RG_NOTIF = 'This not ification must be pr ocessed us ing the Su rgery tab, ' + CRLF + | |
481 | 'which is not curre ntly avail able to yo u.'; | |
482 | TC_NO_SU RG_NOTIF = 'Surgery Tab Not Av ailable'; | |
483 | TX_VER1 = 'T his is ver sion '; | |
484 | TX_VER2 = ' of CPRSCha rt.exe.'; | |
485 | TX_VER3 = CR LF + 'The running se rver versi on is '; | |
486 | TX_VER_R EQ = ' version se rver is re quired.'; | |
487 | TX_VER_O LD = CR LF + 'It i s strongly recommend ed that yo u upgrade. '; | |
488 | TX_VER_O LD2 = CR LF + 'The program ca nnot be ru n until th e client i s upgraded .'; | |
489 | TX_VER_N EW = CR LF + 'The program ca nnot be ru n until th e server i s upgraded .'; | |
490 | TC_VER = 'S erver/Clie nt Incompa tibility'; | |
491 | TC_CLIER R = 'C lient Spec ifications Mismatch' ; | |
492 | ||
493 | SHOW_NOT IFICATIONS = True; | |
494 | ||
495 | TC_DGSR_ ERR = ' Remote Dat a Error'; | |
496 | TC_DGSR_ SHOW = ' Restricted Remote Re cord'; | |
497 | TC_DGSR_ DENY = ' Remote Acc ess Denied '; | |
498 | TX_DGSR_ YESNO = C RLF + 'Do you want t o continue accessing this remo te patient record?'; | |
499 | ||
500 | TX_CCOW_ LINKED = 'Clinical Link On'; | |
501 | TX_CCOW_ CHANGING = 'Clinical link chan ging'; | |
502 | TX_CCOW_ BROKEN = 'Clinical link brok en'; | |
503 | TX_CCOW_ ERROR = 'CPRS was unable to communica te with th e CCOW Con text Vault ' + CRLF + | |
504 | 'CCOW pat ient synch ronization will be u navailable for the r emainder o f this ses sion.'; | |
505 | TC_CCOW_ ERROR = 'CCOW Err or'; | |
506 | ||
507 | function T frmFrame.T imeoutCond ition: boo lean; | |
508 | begin | |
509 | Result : = (FCreate Progress < FCP_PTSEL ); | |
510 | end; | |
511 | ||
512 | function T frmFrame.G etTimedOut : boolean; | |
513 | begin | |
514 | Result : = uInit.Ti medOut; | |
515 | end; | |
516 | ||
517 | procedure TfrmFrame. TimeOutAct ion; | |
518 | var | |
519 | ClosingC PRS: boole an; | |
520 | ||
521 | procedur e CloseCPR S; | |
522 | begin | |
523 | if Clo singCPRS t hen | |
524 | halt ; | |
525 | try | |
526 | Clos ingCPRS := TRUE; | |
527 | Clos e; | |
528 | except | |
529 | halt ; | |
530 | end; | |
531 | end; | |
532 | ||
533 | begin | |
534 | ClosingC PRS := FAL SE; | |
535 | try | |
536 | if ass igned(frmO therSchedu le) then f rmOtherSch edule.Clos e; | |
537 | if ass igned (frm IVRoutes) then frmIV Routes.Clo se; | |
538 | if frm Frame.DLLA ctive then | |
539 | begin | |
540 | Clo seVitalsDL L(); | |
541 | Clo seMHDLL(); | |
542 | end; | |
543 | CloseC PRS; | |
544 | except | |
545 | CloseC PRS; | |
546 | end; | |
547 | end; | |
548 | ||
549 | { General Functions and Proced ures } | |
550 | ||
551 | ||
552 | // NAME: OROTHCL G ET | |
553 | // ROUTINE: GET^OROTH CL | |
554 | //RETURN V ALUE TYPE: SINGLE VA LUE | |
555 | // AVA ILABILITY: SUBSCRIPT ION | |
556 | // DE SCRIPTION: | |
557 | //The Othe r Than Hon orable Dis charge ini tiative al low for ce rtain pati ents to | |
558 | // have li mited ment al health access. T hese indiv iduals are entitled to two 90 | |
559 | // day ter ms of care in a 365 day period . This RP C returns the status of the cl ock | |
560 | // for an applicatio n to displ ay as it s ees fit. | |
561 | // | |
562 | // INPUT PARAMETER : DFN | |
563 | // PAR AMETER TYP E: LITERAL | |
564 | //MAXIMUM DATA LENGT H: 100 n eed to edi t this to a lower va lue, say 1 2 | |
565 | // REQUIRE D: YES | |
566 | // SEQU ENCE NUMBE R: 1 | |
567 | // D ESCRIPTION : This is a pointer to the PAT IENT file. | |
568 | // | |
569 | //RETURN P ARAMETER D ESCRIPTION : | |
570 | //This ret urn parame ter should contain a ll the inf ormation t he client needs to | |
571 | // display informati on about t he OTHD cl ock withou t the clie nt having to do any | |
572 | // calcula tions. Th e return s tring is o f the foll owing form at: | |
573 | // | |
574 | //If some kind of er ror condit ion is enc ountered, return | |
575 | // -1^e rror messa ge | |
576 | // -2^O TH functio nality is not availa ble (DG AP I is not a vailable) | |
577 | //Else ret urn p1^p2^ p3^p4^p5^p 6^p7^p8 wh ere | |
578 | // | |
579 | //Type <En ter> to co ntinue or '^' to exi t: | |
580 | // p1 = status code of 0, 1,2,or 3 | |
581 | // 0 means pati ent is not OTHD elig ible | |
582 | // 1 if the pat ient is in the first 90 day pe riod | |
583 | // 2 if the pat ient is in the secon d 90 day p eriod | |
584 | // 3 if the pat ient has u sed all 18 0 days in a 365 day period | |
585 | // p2 = FM date for the s tart of th e clock fo r the firs t 90 day p eriod | |
586 | // p3 = FM date for the e nd of the clock for the first 90 day per iod | |
587 | // p4 = the num ber of day s left in the first 90 day per iod | |
588 | // p5 = FM date for the s tart of th e clock fo r the seco nd 90 day period | |
589 | // p6 = FM date for the e nd of the clock for the second 90 day pe riod | |
590 | // p7 = the num ber of day s left in the second 90 day pe riod | |
591 | // p8 = FM date of the au thorizatio n for the 2nd period (null if no authori zation) | |
592 | ||
593 | // The Res ults array contains one or mor e rows: | |
594 | // First r ow contain s a counte r of the n umber of r ows availa ble starti ng with th e second r ow | |
595 | // If avai lable, the second ro w contains pieces 1 through 8 starting w ith the st atus code | |
596 | // If avai lable, the third row contains a message defined lo cally at t he divisio n | |
597 | ||
598 | function g etOTHD(DFN Str, NameS tr: String ; out Shor tStr, Long Str1, Long Str2, Loca lMsg: Stri ng): Boole an; // rpk 3/6/2018 | |
599 | const | |
600 | OTHRPC = 'OROTHCL GET'; | |
601 | OTHDMIND AYS = 7; | |
602 | var | |
603 | i, p1day sleft, p2d aysleft, i cnt, rcnt: Integer; | |
604 | tmpstr, p1, p2, p3 , p4, p5, p6, p7, p8 , row2, rs tr: String ; | |
605 | p5datest r: String; | |
606 | dt: TDat eTime; | |
607 | FMdt: TF MDateTime; | |
608 | DOS: Str ing; | |
609 | mindayss tr: String ; | |
610 | Results: TStrings; | |
611 | ||
612 | begin | |
613 | tmpstr : = ''; | |
614 | p1 := '' ; | |
615 | ShortStr := ''; | |
616 | LongStr1 := ''; | |
617 | LongStr2 := ''; | |
618 | LocalMsg := ''; | |
619 | row2 := ''; | |
620 | Result : = False; | |
621 | // rcnt : = 0; | |
622 | dt := to day; | |
623 | FMdt := DateTimeTo FMDateTime (dt); | |
624 | DOS := F ormatFMDat eTime('mmm dd, yyyy' , FMdt); | |
625 | mindayss tr := IntT oStr(OTHDM INDAYS); | |
626 | // CallV (OTHRPC, [ DFNStr, DO S]); // r pk 3/27/20 18 | |
627 | Results := TString List.Creat e; | |
628 | try | |
629 | if Cal lVistA(OTH RPC, [DFNS tr, DOS], Results) t hen // rpk 3/27/2018 | |
630 | begin | |
631 | icnt := {RPCBr okerV.}Res ults.Count ; | |
632 | if ( icnt > 0) then begin // rpk 5 /5/2018 | |
633 | tm pstr := {R PCBrokerV. }Results[0 ]; | |
634 | tm pstr := Tr im(tmpstr) ; | |
635 | rc nt := StrT oIntDef(tm pstr, -3); | |
636 | if rcnt <> ( icnt - 1) then begin | |
637 | // add loo p which di splays raw results i n message after coun ts; rpk 5/ 7/2018 | |
638 | rstr := tm pstr; | |
639 | for I := 1 to icnt - 1 do | |
640 | rstr := rstr + CRL F + {RPCBr okerV.}Res ults[i]; | |
641 | ShowMsg('g etOTHD: Re sults.Coun t=' + IntT oStr(icnt) + ', Resu lts[0]='+ IntToStr(r cnt) + | |
642 | ', Resul ts=' + CRL F + rstr); | |
643 | en d; | |
644 | end; | |
645 | ||
646 | if i cnt > 1 th en begin // rpk 5/3 /2018 | |
647 | tm pstr := {R PCBrokerV. }Results[1 ]; | |
648 | tm pstr := Tr im(tmpstr) ; | |
649 | end; | |
650 | if L ength(tmps tr) = 0 th en | |
651 | ex it; | |
652 | p1 : = Piece(tm pstr, U, 1 ); | |
653 | i := StrToIntD ef(p1, -3) ; | |
654 | if i <= 0 then | |
655 | ex it; | |
656 | ||
657 | p2 : = piece(tm pstr, U, 2 ); | |
658 | p3 : = piece(tm pstr, U, 3 ); | |
659 | p4 : = piece(tm pstr, U, 4 ); | |
660 | p4 : = trim(p4) ; | |
661 | p1da ysleft := StrToIntDe f(p4, -1); // rpk 4 /12/2018 | |
662 | p5 : = piece(tm pstr, U, 5 ); | |
663 | p5 : = trim(p5) ; | |
664 | p6 : = piece(tm pstr, U, 6 ); | |
665 | p7 : = piece(tm pstr, U, 7 ); | |
666 | p7 : = trim(p7) ; | |
667 | p2da ysleft := StrToIntDe f(p7, -1); // rpk 4 /12/2018 | |
668 | p8 : = piece(tm pstr, U, 8 ); | |
669 | p8 : = trim(p8) ; | |
670 | if p 5 > '' the n | |
671 | p5 datestr := FormatFMD ateTimeStr ('mmm dd, yyyy', p5) | |
672 | else | |
673 | p5 datestr := ''; | |
674 | ||
675 | if i cnt > 2 th en begin | |
676 | ro w2 := {RPC BrokerV.}R esults[2]; | |
677 | ro w2 := Trim (row2); | |
678 | end; | |
679 | ||
680 | case i of | |
681 | 1: begin | |
682 | // show wa rning only if p1 day s is less than 7 and | |
683 | // there i s no autho rization f or the sec ond period | |
684 | if (p1days left < OTH DMINDAYS) and (p8 = '') then // rpk 4/2 6/2018 | |
685 | ShowMsg( 'WARNING: Other Than Honorable Status' + CRLF + | |
686 | 'Less th an ' + min daysstr + ' days lef t in the 1 st 90 Day Period.'); | |
687 | ||
688 | Shortstr : = p4 + 'D, P1'; // fi rst period | |
689 | LongStr1 : = '1st 90 Day Period : ' + p4 + ' Day(s) Remaining' ; // rpk 4/12/2018 | |
690 | if Length( p8) > 0 th en begin | |
691 | // first period an d second p eriod are authorized | |
692 | if (p5 > '') and ( p7 > '') t hen | |
693 | LongSt r2 := '2nd 90 Day Pe riod: ' + p7 + ' Day (s) are au thorized s tarting on ' + p5dat estr + '.' | |
694 | else | |
695 | // no start date for secon d period | |
696 | LongSt r2 := '2nd 90 Day Pe riod: has been autho rized with out a star ting date. '; | |
697 | end | |
698 | else begin // in fir st period, second pe riod has n ot been au thorized y et | |
699 | if p1day sleft = 0 then begin // zero days left in first p eriod, 2nd period no t authoriz ed; rpk 5/ 8/2018 | |
700 | LongSt r1 := 'Pat ient is NO T eligible for care at this ti me.'; | |
701 | LongSt r2 := 'Aut horization is requir ed for fur ther care. '; | |
702 | end | |
703 | else | |
704 | LongSt r2 := '2nd 90 Day Pe riod: Auth orization Required'; | |
705 | end; | |
706 | en d; // 1 | |
707 | 2: begin | |
708 | if (p2days left < OTH DMINDAYS) then | |
709 | ShowMsg( 'WARNING: Other Than Honorable Status' + CRLF + | |
710 | 'Less th an ' + min daysstr + ' days lef t in the 2 nd 90 Day Period.'); | |
711 | ||
712 | ShortStr : = p7 + 'D, P2'; // se cond perio d | |
713 | Longstr1 : = '2nd 90 Day Period : ' + p7 + ' Day(s) Remaining' ; | |
714 | if Length( p8) = 0 th en | |
715 | // secon d period h as not bee n authoriz ed yet | |
716 | LongStr2 := 'WARNI NG: Author ization fo r the 2nd period is required!' ; | |
717 | en d; // 2 | |
718 | 3: begin | |
719 | Shortstr : = '0D,P2'; // 365 d ay period expired; r pk 1/10/20 18 | |
720 | Longstr1 : = 'Both 90 day perio ds have ex pired in t his 365 da y period.' ; // 365 day period expired | |
721 | LongStr2 : = 'Patient is NOT el igible for care at t his time.' ; | |
722 | en d; // 3 | |
723 | end; // case i | |
724 | ||
725 | if r ow2 > '' t hen | |
726 | Lo calMsg := row2; | |
727 | end; | |
728 | finally | |
729 | Result s.Free; | |
730 | end; | |
731 | ||
732 | Result : = True; | |
733 | end; // g etOTHD | |
734 | ||
735 | procedure TfrmFrame. AppExcepti on(Sender: TObject; E: Excepti on); | |
736 | const | |
737 | XWB_M_REJ ECT = 2000 0 + 2; // M error | |
738 | var | |
739 | AnAddr: Pointer; | |
740 | ErrMsg: string; | |
741 | ||
742 | begin | |
743 | Applicat ion.Normal izeTopMost s; | |
744 | if (E is EIntError ) then | |
745 | begin | |
746 | ErrMsg := E.Mess age + CRLF + | |
747 | 'Creat eProgress: ' + IntTo Str(FCreat eProgress) + CRLF + | |
748 | 'RPC I nfo: ' + R PCLastCall ; | |
749 | if EEx ternal(E). ExceptionR ecord <> n il then | |
750 | begin | |
751 | AnAd dr := EExt ernal(E).E xceptionRe cord^.Exce ptionAddre ss; | |
752 | ErrM sg := ErrM sg + CRLF + 'Address was ' + I ntToStr(In teger(AnAd dr)); | |
753 | end; | |
754 | //Pass this mess age up | |
755 | E.Mess age := Err Msg; | |
756 | end; | |
757 | ||
758 | if (E is EBrokerEr ror) or (E is EOleEx ception) t hen | |
759 | begin | |
760 | FCreat eProgress := FCP_FOR MS; | |
761 | ||
762 | //Opt ion for cu stom actio n | |
763 | { | |
764 | if (E is EBroke rError) th en | |
765 | begin | |
766 | if EBrokerErr or(E).Code = XWB_M_R EJECT then | |
767 | beg in | |
768 | Ex ceptionLog .CustomBut tonCaption := 'Debug '; | |
769 | Ex ceptionLog .OnCustomM ethod := m nuDebugRep ortClick; | |
770 | end ; | |
771 | end; | |
772 | } | |
773 | ||
774 | //Tell the excep tion logge r that we can't cont inue | |
775 | Except ionLog.Ter minateApp := true; | |
776 | end; | |
777 | Applicat ion.Restor eTopMosts; | |
778 | end; | |
779 | ||
780 | procedure TfrmFrame. btnCombatV etClick(Se nder: TObj ect); | |
781 | begin | |
782 | inherite d; | |
783 | frmComba tVet := Tf rmCombatVe t.Create(f rmFrame); | |
784 | frmComba tVet.ShowM odal; | |
785 | frmComba tVet.Free; | |
786 | end; | |
787 | ||
788 | function T frmFrame.A llowContex tChangeAll (var Reaso n: string) : Boolean; | |
789 | var | |
790 | Silent: Boolean; | |
791 | begin | |
792 | if pnlNo PatientSel ected.Visi ble then | |
793 | begin | |
794 | Result := True; | |
795 | exit; | |
796 | end; | |
797 | FContext Changing : = True; | |
798 | Result : = True; | |
799 | if COMOb jectActive or SpellC heckInProg ress or DL LActive th en | |
800 | begin | |
801 | Reas on := 'COM _OBJECT_AC TIVE'; | |
802 | Resu lt:= False ; | |
803 | end; | |
804 | // frmCo verSheet w ill always AllowCont extChange | |
805 | if Resul t then Res ult := frm Problems.A llowContex tChange(Re ason); | |
806 | if Resul t then Res ult := frm Meds.Allow ContextCha nge(Reason ); | |
807 | if Resul t then Res ult := frm Orders.All owContextC hange(Reas on); | |
808 | if Resul t then Res ult := frm Notes.Allo wContextCh ange(Reaso n); | |
809 | if Resul t then Res ult := frm Consults.A llowContex tChange(Re ason); | |
810 | if Resul t then Res ult := frm DCSumm.All owContextC hange(Reas on); | |
811 | if Resul t then | |
812 | if Ass igned(frmS urgery) th en Result := frmSurg ery.AllowC ontextChan ge(Reason) ;; | |
813 | if Resul t then Res ult := frm Labs.Allow ContextCha nge(Reason );; | |
814 | if Resul t then Res ult := frm Reports.Al lowContext Change(Rea son); | |
815 | if Resul t then Res ult := frm GraphData. AllowConte xtChange(R eason); | |
816 | if (not User.IsRep ortsOnly) then | |
817 | if Res ult and Ch anges.Requ ireReview then //Res ult := Rev iewChanges (TimedOut) ; | |
818 | case BOOLCHAR[ FCCOWConte xtChanging ] of | |
819 | '1 ': begin | |
820 | if Ch anges.Requ ireReview then | |
821 | beg in | |
822 | R eason := ' Items will be left u nsigned.'; | |
823 | R esult := F alse; | |
824 | end | |
825 | else | |
826 | Res ult := Tru e; | |
827 | end; | |
828 | '0 ': begin | |
829 | Silen t := (Time dOut) or ( Reason = ' COMMIT'); | |
830 | Resul t := Revie wChanges(S ilent); | |
831 | end; | |
832 | end; | |
833 | FContext Changing : = False; | |
834 | end; | |
835 | ||
836 | // TDrugs Patch OR*3 *377 and W V*1*24 - D anP@SLC 11 -20-2015 | |
837 | // Added s o the cove rsheet had a quick w ay to upda te. | |
838 | procedure TfrmFrame. RefreshCWA D(Sender: TObject); | |
839 | begin | |
840 | lblPtCWA D.Caption := GetCWAD Info(Patie nt.DFN); | |
841 | if Lengt h(lblPtCWA D.Caption) > 0 then | |
842 | lblPtP ostings.Ca ption := ' Postings' | |
843 | else | |
844 | lblPtP ostings.Ca ption := ' No Posting s'; | |
845 | pnlPosti ngs.Captio n := lblPt Postings.C aption + ' ' + lblPt CWAD.Capti on; | |
846 | end; | |
847 | ||
848 | procedure TfrmFrame. ClearPatie nt; | |
849 | { call all pages to make sure patient re lated info rmation is cleared ( when switc hing patie nts) } | |
850 | var | |
851 | aCPRSTab : ICPRSTab ; | |
852 | begin | |
853 | //if frm Frame.Time dout then Exit; // a dded to co rrect Acce ss Violati on when "R efresh Pat ient Infor mation" se lected | |
854 | lblPtNam e.Caption := ''; | |
855 | lblPtSSN .Caption := ''; | |
856 | lblPtAge .Caption := ''; | |
857 | pnlPatie nt.Caption := ''; | |
858 | lblPtCWA D.Caption := ''; | |
859 | lblOTHD. Caption := ''; // rpk 1 2/5/2017 | |
860 | pnlOTHD. Hide; // rpk 1 2/6/2017 | |
861 | pnlOTHD. Enabled := Fal se; // rpk 12/6/2017 | |
862 | lblOTHD. Enabled := Fal se; // rpk 4/6/2018 | |
863 | lblOTHDT itle.Enabl ed := Fal se; // rpk 12/6/2017 | |
864 | OTHDShor tStr := ''; // rpk 1 /5/2018 | |
865 | OTHDLong Str1 := ''; // rpk 1 /5/2018 | |
866 | OTHDLong Str2 := ''; // rpk 1 /5/2018 | |
867 | OTHDLoca lMsg := ''; // rpk 2 /28/2018 | |
868 | ||
869 | if DoNot ChangeEncW indow = fa lse then | |
870 | begin | |
871 | lblP tLocation. Caption := 'Visit No t Selected '; | |
872 | lblP tProvider. Caption := 'Current Provider N ot Selecte d'; | |
873 | pnlV isit.Capti on := lblPtLoca tion.Capti on + CRLF + lblPtPro vider.Capt ion; | |
874 | end; | |
875 | lblPtCar e.Caption := 'Pr imary Care Team Unas signed'; | |
876 | lblPtAtt ending.Cap tion := '' ; | |
877 | lblPtMHT C.Caption := ''; | |
878 | pnlPrima ryCare.Cap tion := lb lPtCare.Ca ption + ' ' + lblPtA ttending.C aption + ' ' + lblPt MHTC.Capti on; | |
879 | if Suppo rts(frmCov erSheet, I CPRSTab, a CPRSTab) t hen | |
880 | aCPRST ab.OnClear PtData(Sel f); | |
881 | frmProbl ems.ClearP tData; | |
882 | frmMeds. ClearPtDat a; | |
883 | frmOrder s.ClearPtD ata; | |
884 | frmNotes .ClearPtDa ta; | |
885 | frmConsu lts.ClearP tData; | |
886 | frmDCSum m.ClearPtD ata; | |
887 | if Assig ned(frmSur gery) then frmSurger y.ClearPtD ata; | |
888 | frmLabs. ClearPtDat a; | |
889 | frmGraph Data.Clear PtData; | |
890 | frmRepor ts.ClearPt Data; | |
891 | tabPage. TabIndex : = PageIDTo Tab(CT_NOP AGE); // to ma ke sure Di splayPage gets calle d | |
892 | tabPageC hange(tabP age); | |
893 | ClearRem inderData; | |
894 | SigItems .Clear; | |
895 | Changes. Clear; | |
896 | lstCIRNL ocations.C lear; | |
897 | ClearFla g; | |
898 | if Assig ned(FlagLi st) then F lagList.Cl ear; | |
899 | HasFlag := False; | |
900 | HidePati entSelectM essages; | |
901 | if (Grap hFloat <> nil) and G raphFloatA ctive then | |
902 | with Gra phFloat do | |
903 | begin | |
904 | Initia lize; | |
905 | Displa yData('top '); | |
906 | Displa yData('bot tom'); | |
907 | Captio n := 'CPRS Graphing - Patient: ' + Mixed Case(Patie nt.Name); | |
908 | end; | |
909 | if frmFr ame.TimedO ut then | |
910 | begin | |
911 | infoBo x('CPRS ha s encounte red a seri ous proble m and is u nable to d isplay the selected patient''s data. ' | |
912 | + 'To pr event pati ent safety issues, C PRS is shu tting down . Shutting down and then resta rting CPRS will corr ect the pr oblem, and you may c ontinue wo rking in C PRS.' | |
913 | + CRLF + CRLF + ' Please rep ort all oc currences of this pr oblem by c ontacting your CPRS Help Desk. ', 'CPRS E rror', MB_ OK); | |
914 | frmFra me.Close; | |
915 | end; | |
916 | end; | |
917 | ||
918 | procedure TfrmFrame. DigitalSig ningSetup1 Click(Send er: TObjec t); | |
919 | var | |
920 | aPKIEncr yptionEngi ne: IPKIEn cryptionEn gine; | |
921 | aDefault Msg: strin g; | |
922 | aSuccess Msg: strin g; | |
923 | aResults : TStringL ist; | |
924 | begin | |
925 | try | |
926 | // get PKI engin e componen ts ready | |
927 | NewPKI Encryption Engine(RPC BrokerV, a PKIEncrypt ionEngine) ; | |
928 | ||
929 | aResul ts := TStr ingList.Cr eate; | |
930 | try | |
931 | Call VistA('ORD EA LNKMSG' , [], aRes ults); | |
932 | aSuc cessMsg := aResults. Text; | |
933 | finall y | |
934 | Free AndNil(aRe sults); | |
935 | end; | |
936 | ||
937 | if not IsDigital SignatureA vailable(a PKIEncrypt ionEngine, aDefaultM sg, aSucce ssMsg) the n | |
938 | Show Msg('There was a pro blem linki ng your PI V card. Ei ther the ' | |
939 | + 'PIV card name does NOT match your VistA account n ame or the PIV card is already ' | |
940 | + 'linked to another V istA accou nt. Ensur e that the correct P IV card ha s ' | |
941 | + 'been inse rted for y our VistA account. P lease cont act your P IV Card Co ordinator ' | |
942 | + 'if you co ntinue to have probl ems.'); | |
943 | except | |
944 | on E: Exception do | |
945 | Show Msg('Probl em during digital si gning setu p: ' + E.M essage); | |
946 | end; | |
947 | end; | |
948 | ||
949 | procedure TfrmFrame. DisplayEnc ounterText ; | |
950 | { updates the displa y in the h eader bar of encount er related informati on (locati on & provi der) } | |
951 | begin | |
952 | if DoNot ChangeEncW indow = tr ue then ex it; | |
953 | with Enc ounter do | |
954 | begin | |
955 | if Len gth(Locati onText) > 0 | |
956 | then lblPtLoca tion.Capti on := Loca tionText | |
957 | else lblPtLoca tion.Capti on := 'Vis it Not Sel ected'; | |
958 | if Len gth(Provid erName) > 0 | |
959 | then lblPtProv ider.Capti on := 'Pro vider: ' + Provider Name | |
960 | else lblPtProv ider.Capti on := 'Cur rent Provi der Not Se lected'; | |
961 | end; | |
962 | pnlVisit .Caption : = lblPtLoc ation.Capt ion + CRLF + lblPtPr ovider.Cap tion; | |
963 | FitToolB ar; | |
964 | end; | |
965 | ||
966 | function T frmFrame.D LLActive: boolean; | |
967 | begin | |
968 | Result : = (VitalsD LLHandle < > 0) or (M HDLLHandle <> 0); | |
969 | end; | |
970 | ||
971 | { Form Eve nts (Creat e, Destroy ) -------- ---------- ---------- ---------- ---------- ---------- - } | |
972 | ||
973 | ||
974 | procedure TfrmFrame. RefreshFix edStatusWi dth; | |
975 | begin | |
976 | with sts Area do | |
977 | FFixed StatusWidt h := Panel s[0].Width + Panels[ 2].Width + Panels[3] .Width + P anels[4].W idth; | |
978 | end; | |
979 | ||
980 | procedure TfrmFrame. FormCreate (Sender: T Object); | |
981 | { connect to server, create ta b pages, s elect a pa tient, & i nitialize core objec ts } | |
982 | var | |
983 | ClientVe r, ServerV er, Server Req, SAN: string; | |
984 | ||
985 | Procedur e LoadExce ptionLogge r; | |
986 | var | |
987 | TmpLst: TStringLi st; | |
988 | TmpStr: String; | |
989 | begin | |
990 | TmpLst := TStrin gList.Crea te; | |
991 | try | |
992 | Except ionLog.Day sToPurge : = StrToInt Def(GetUse rParam('OR CPRS EXCE PTION PURG E'), 60); | |
993 | Except ionLog.Ena bled := St rToBoolDef (GetUserPa ram('OR CP RS EXCEPTI ON LOGGER' ), false); | |
994 | GetUse rListParam (TmpLst, ' OR CPRS EX CEPTION EM AIL'); | |
995 | for Tm pStr in Tm pLst do | |
996 | Excep tionLog.Em ailTo.Add( Piece(TmpS tr, U, 2)) ; | |
997 | Except ionLog.OnA ppExceptio n := AppEx ception; | |
998 | finall y | |
999 | TmpL st.Free; | |
1000 | end; | |
1001 | end; | |
1002 | ||
1003 | begin | |
1004 | FJustEnt eredApp := false; | |
1005 | SizeHold er := TSiz eHolder.Cr eate; | |
1006 | FOldActi veFormChan ge := Scre en.OnActiv eFormChang e; | |
1007 | Screen.O nActiveFor mChange := ScreenAct iveFormCha nge; | |
1008 | FCCOWJus tJoined := False; | |
1009 | if not ( ParamSearc h('CCOW')= 'DISABLE') then | |
1010 | try | |
1011 | Star tCCOWConte xtor; | |
1012 | FCCO WJustJoine d := True; | |
1013 | except | |
1014 | IsRu nExecuted := False; | |
1015 | FCCO WInstalled := False; | |
1016 | pnlC COW.Visibl e := False ; | |
1017 | mnuF ileResumeC ontext.Vis ible := Fa lse; | |
1018 | mnuF ileBreakCo ntext.Visi ble := Fal se; | |
1019 | end | |
1020 | else | |
1021 | begin | |
1022 | IsRu nExecuted := False; | |
1023 | FCCO WInstalled := False; | |
1024 | pnlC COW.Visibl e := False ; | |
1025 | mnuF ileResumeC ontext.Vis ible := Fa lse; | |
1026 | mnuF ileBreakCo ntext.Visi ble := Fal se; | |
1027 | end; | |
1028 | ||
1029 | RefreshF ixedStatus Width; | |
1030 | FTermina te := Fals e; | |
1031 | ||
1032 | FFlagLis t := TStri ngList.Cre ate; | |
1033 | ||
1034 | // setup initial t imeout her e so can t imeout log on | |
1035 | FCreateP rogress := FCP_SETHO OK; | |
1036 | InitTime Out(Timeou tCondition , TimeOutA ction); | |
1037 | ||
1038 | // conne ct to the server and create an option co ntext | |
1039 | FCreateP rogress := FCP_SERVE R; | |
1040 | ||
1041 | {$IFDEF CC OWBROKER} | |
1042 | EnsureBr oker; | |
1043 | if ctxCo ntextor <> nil then | |
1044 | begin | |
1045 | if Par amSearch(' CCOW') = ' PATIENTONL Y' then | |
1046 | RPCB rokerV.Con textor := nil | |
1047 | else | |
1048 | RPCB rokerV.Con textor := ctxContext or; | |
1049 | end | |
1050 | else | |
1051 | RPCBro kerV.Conte xtor := ni l; | |
1052 | {$ENDIF} | |
1053 | ||
1054 | if not C onnectToSe rver(TX_OP TION) then | |
1055 | begin | |
1056 | if Ass igned(RPCB rokerV) th en | |
1057 | Info Box(RPCBro kerV.RPCBE rror, 'Err or', MB_OK or MB_ICO NERROR); | |
1058 | Close; | |
1059 | Exit; | |
1060 | end; | |
1061 | ||
1062 | if ctxCo ntextor <> nil then | |
1063 | begin | |
1064 | if not (ParamSea rch('CCOW' ) = 'PATIE NTONLY') t hen | |
1065 | ctxC ontextor.N otificatio nFilter := ctxContex tor.Notifi cationFilt er + ';Use r'; | |
1066 | end; | |
1067 | ||
1068 | FECSAuth User := Va lidECSUser ; | |
1069 | uECSRepo rt := TECS Report.Cre ate; | |
1070 | uECSRepo rt.ECSPerm it := FECS AuthUser; | |
1071 | RPCBroke rV.CreateC ontext(TX_ OPTION); | |
1072 | // Applic ation.OnEx ception := AppExcept ion; | |
1073 | LoadExce ptionLogge r; | |
1074 | FOldActi vate := Ap plication. OnActivate ; | |
1075 | Applicat ion.OnActi vate := Ap pActivated ; | |
1076 | Applicat ion.OnDeAc tivate := AppDeActiv ated; | |
1077 | ||
1078 | // creat e initial core objec ts | |
1079 | FCreateP rogress := FCP_OBJEC TS; | |
1080 | User := TUser.Crea te; | |
1081 | ||
1082 | // make sure we're using the matching server ver sion | |
1083 | FCreateP rogress := FCP_CHKVE R; | |
1084 | ClientVe r := Clien tVersion(A pplication .ExeName); | |
1085 | ServerVe r := Serve rVersion(T X_OPTION, ClientVer) ; | |
1086 | if (Serv erVer = '0 .0.0.0') t hen | |
1087 | begin | |
1088 | InfoBo x('Unable to determi ne current version o f server.' , TX_OPTIO N, MB_OK); | |
1089 | Close; | |
1090 | Exit; | |
1091 | end; | |
1092 | ServerRe q := Piece (FileVersi onValue(Ap plication. ExeName, F ILE_VER_IN TERNALNAME ), ' ', 1) ; | |
1093 | if (Clie ntVer <> S erverReq) then | |
1094 | begin | |
1095 | InfoBo x('Client "version" does not m atch clien t "require d" server. ', TC_CLIE RR, MB_OK) ; | |
1096 | Close; | |
1097 | Exit; | |
1098 | end; | |
1099 | // SAN := sCallV('X US PKI GET UPN', []) ; | |
1100 | // if SAN ='' then D igitalSign ingSetup1. Visible := True | |
1101 | // else D igitalSign ingSetup1. Visible := False; | |
1102 | SAN := ' '; | |
1103 | DigitalS igningSetu p1.Visible := CallVi stA('XUS P KI GET UPN ', [],SAN) and (SAN = ''); | |
1104 | ||
1105 | if (Comp areVersion (ServerVer , ServerRe q) <> 0) t hen | |
1106 | begin | |
1107 | // if ( sCallV('OR WU DEFAULT DIVISION' , [nil]) = '1') then | |
1108 | if Cal lVistA('OR WU DEFAULT DIVISION' , [nil],SA N) and (SA N = '1') t hen | |
1109 | begin | |
1110 | if ( InfoBox('P roceed wit h mismatch ed Client and Server versions? ', TC_CLIE RR, MB_YES NO) = ID_N O) then | |
1111 | begi n | |
1112 | Cl ose; | |
1113 | Ex it; | |
1114 | end; | |
1115 | end | |
1116 | else | |
1117 | begin | |
1118 | if ( CompareVer sion(Serve rVer, Serv erReq) > 0 ) then // Server new er than Re quired | |
1119 | begi n | |
1120 | // NEXT LINE COMMENTED OUT - CHA NGED FOR V ERSION 19. 16, PATCH OR*3*155: | |
1121 | // if G etUserPara m('ORWOR R EQUIRE CUR RENT CLIEN T') = '1' then | |
1122 | if (true) th en // "Tru e" stateme nt guarant ees "requi red" curre nt version client. | |
1123 | be gin | |
1124 | InfoBox(TX _VER1 + Cl ientVer + TX_VER2 + CRLF + Ser verReq + T X_VER_REQ + TX_VER3 + ServerVe r + '.' + TX_VER_OLD 2, TC_VER, MB_OK); | |
1125 | Close; | |
1126 | Exit; | |
1127 | en d; | |
1128 | end | |
1129 | else InfoBox(T X_VER1 + C lientVer + TX_VER2 + CRLF + Se rverReq + TX_VER_REQ + TX_VER3 + ServerV er + '.' + TX_VER_OL D, TC_VER, MB_OK); | |
1130 | end; | |
1131 | if (Co mpareVersi on(ServerV er, Server Req) < 0) then // Se rver older then Requ ired | |
1132 | begin | |
1133 | Info Box(TX_VER 1 + Client Ver + TX_V ER2 + CRLF + ServerR eq + TX_VE R_REQ + TX _VER3 + Se rverVer + '.' + TX_V ER_NEW, TC _VER, MB_O K); | |
1134 | Clos e; | |
1135 | Exit ; | |
1136 | end; | |
1137 | end; | |
1138 | ||
1139 | // Add f uture tabs here as t hey are cr eated/impl emented: | |
1140 | if ( | |
1141 | (not User.HasCo rTabs) and | |
1142 | (not User.HasRp tTab) | |
1143 | ) | |
1144 | then | |
1145 | begin | |
1146 | InfoBo x('No vali d tabs ass igned', 'T ab Access Problem', MB_OK); | |
1147 | Close; | |
1148 | Exit; | |
1149 | end; | |
1150 | // Globa l flags se t by serve r | |
1151 | IsLeJeun eActive := ServerHas Patch(Camp LejeunePat ch); | |
1152 | SpansInt lDateLine := SiteSpa nsIntlDate Line; | |
1153 | ||
1154 | // creat e creating core obje cts | |
1155 | Patient := TPatien t.Create; | |
1156 | Encounte r := TEnco unter.Crea te; | |
1157 | Changes := TChange s.Create; | |
1158 | Notifica tions := T Notificati ons.Create ; | |
1159 | RemoteSi tes := TRe moteSiteLi st.Create; | |
1160 | RemoteRe ports := T RemoteRepo rtList.Cre ate; | |
1161 | uTabList := TStrin gList.Crea te; | |
1162 | FlaggedP TList := T StringList .Create; | |
1163 | HasFlag := False; | |
1164 | FlagList := TStrin gList.Crea te; | |
1165 | ||
1166 | //Set th e mix case exclusion event | |
1167 | GetExclu dedFromMix ed; | |
1168 | ||
1169 | // set u p structur es specifi c to the u ser | |
1170 | ||
1171 | Caption := TX_IN_U SE + Mixed Case(User. Name) + ' (' + Stri ng(RPCBrok erV.Server ) + ')'// + | |
1172 | {$IFDEF PA PITEST} | |
1173 | + ' ' + FileVer sionValue( Applicatio n.ExeName, FILE_VER_ DEBUG); | |
1174 | {$ENDIF} | |
1175 | ; | |
1176 | SetDebug Menu; | |
1177 | if Inter activeRemi ndersActiv e then | |
1178 | Notify WhenRemind ersChange( RemindersC hanged); | |
1179 | // load all the ta b pages | |
1180 | FCreateP rogress := FCP_FORMS ; | |
1181 | //Create Tab(TObjec t(frmProbl ems), Tfrm Problems, CT_PROBLEM S, 'Proble ms'); | |
1182 | CreateTa b(CT_PROBL EMS, 'Prob lems'); | |
1183 | CreateTa b(CT_MEDS, 'Meds '); | |
1184 | CreateTa b(CT_ORDER S, 'Orde rs'); | |
1185 | CreateTa b(CT_NOTES , 'Note s'); | |
1186 | CreateTa b(CT_CONSU LTS, 'Cons ults'); | |
1187 | if ShowS urgeryTab then Creat eTab(CT_SU RGERY, 'S urgery'); | |
1188 | CreateTa b(CT_DCSUM M, 'D/C Summ'); | |
1189 | CreateTa b(CT_LABS, 'Labs '); | |
1190 | CreateTa b(CT_REPOR TS, 'Repo rts'); | |
1191 | CreateTa b(CT_COVER , 'Cove r Sheet'); | |
1192 | ShowHide ChartTabMe nus(mnuVie wChart); | |
1193 | // We d efer calli ng LoadUse rPreferenc es to UMIn itiate, so that the font sizin g | |
1194 | // routi nes recogn ize this a s the appl ication's main form (this hasn 't been | |
1195 | // set y et). | |
1196 | FNextBut tonBitmap := TBitmap .Create; | |
1197 | FNextBut tonBitmap. LoadFromRe sourceName (hInstance , 'BMP_HAN DRIGHT'); | |
1198 | // set t he timeout to DTIME now that t here is a connection | |
1199 | UpdateTi meOutInter val(User.D TIME * 100 0); // DT IME * 1000 mSec | |
1200 | // get a patient | |
1201 | HandleNe eded; // ma ke sure ha ndle is th ere for OR WPT SHARE call | |
1202 | FCreateP rogress := FCP_PTSEL ; | |
1203 | Enabled := False; | |
1204 | FFirstLo ad := True ; // Fir st time to initializ e the fFra me | |
1205 | FCreateP rogress := FCP_FINIS H; | |
1206 | pnlRemin ders.Visib le := Inte ractiveRem indersActi ve; | |
1207 | GraphFlo atActive : = false; | |
1208 | GraphCon text := '' ; | |
1209 | frmGraph Data := Tf rmGraphDat a.Create(s elf); // form is only v isible for testing | |
1210 | GraphDat aOnUser; | |
1211 | uRemoteT ype := ''; | |
1212 | uLabRemo teType := ''; | |
1213 | uReportI D := ''; | |
1214 | uLabRepI D := ''; | |
1215 | FPrevPtI D := ''; | |
1216 | SetUserT ools; | |
1217 | Enduring PtSelSplit terPos := 0; | |
1218 | Enduring PtSelColum ns := ''; | |
1219 | if User. IsReportsO nly then / / Reports Only tab. | |
1220 | Report sOnlyDispl ay; // Cal ls procedu re to hide all compo nents/menu s not need ed. | |
1221 | InitialO rderVariab les; | |
1222 | ||
1223 | PostMess age(Handle , UM_INITI ATE, 0, 0) ; // se lect patie nt after m ain form i s created | |
1224 | SetFormM onitoring( true); | |
1225 | //Will l oad the co py/paste b uffer | |
1226 | CPAppMon .LoadTheBu ffer; | |
1227 | CPAppMon .LoadThePr operties; | |
1228 | end; | |
1229 | ||
1230 | procedure TfrmFrame. StartCCOWC ontextor; | |
1231 | begin | |
1232 | try | |
1233 | ctxCon textor := TContextor Control.Cr eate(Self) ; | |
1234 | with c txContexto r do | |
1235 | begi n | |
1236 | On Pending := ctxContex torPending ; | |
1237 | On Committed := ctxCont extorCommi tted; | |
1238 | On Canceled : = ctxConte xtorCancel ed; | |
1239 | end; | |
1240 | FCCOWB usy := Fal se; | |
1241 | FCCOWI nstalled : = True; | |
1242 | FCCOWD rivedChang e := False ; | |
1243 | ctxCon textor.Run ('CPRSChar t', '', TR UE, 'Patie nt'); | |
1244 | IsRunE xecuted := True; | |
1245 | except | |
1246 | on exc : EOleExc eption do | |
1247 | begin | |
1248 | IsRu nExecuted := False; | |
1249 | Free AndNil(ctx Contextor) ; | |
1250 | try | |
1251 | ct xContextor := TConte xtorContro l.Create(S elf); | |
1252 | wi th ctxCont extor do | |
1253 | begin | |
1254 | OnPendin g := ctxCo ntextorPen ding; | |
1255 | OnCommit ted := ctx ContextorC ommitted; | |
1256 | OnCancel ed := ctxC ontextorCa nceled; | |
1257 | end; | |
1258 | FC COWBusy := False; | |
1259 | FC COWInstall ed := True ; | |
1260 | FC COWDrivedC hange := F alse; | |
1261 | ct xContextor .Run('CPRS Chart' + ' #', '', TR UE, 'Patie nt'); | |
1262 | Is RunExecute d := True; | |
1263 | if ParamSear ch('CCOW') = 'FORCE' then | |
1264 | be gin | |
1265 | mnuFileRes umeContext .Enabled : = False; | |
1266 | mnuFileBre akContext. Visible := True; | |
1267 | mnuFileBre akContext. Enabled := True; | |
1268 | en d | |
1269 | el se | |
1270 | be gin | |
1271 | ctxContext or.Suspend ; | |
1272 | mnuFileRes umeContext .Visible : = True; | |
1273 | mnuFileBre akContext. Visible := True; | |
1274 | mnuFileBre akContext. Enabled := False; | |
1275 | en d; | |
1276 | exce pt | |
1277 | Is RunExecute d := False ; | |
1278 | FC COWInstall ed := Fals e; | |
1279 | Fr eeAndNil(c txContexto r); | |
1280 | pn lCCOW.Visi ble := Fal se; | |
1281 | mn uFileResum eContext.V isible := False; | |
1282 | mn uFileBreak Context.Vi sible := F alse; | |
1283 | end; | |
1284 | end; | |
1285 | end | |
1286 | end; | |
1287 | ||
1288 | procedure TfrmFrame. UMInitiate (var Messa ge: TMessa ge); | |
1289 | begin | |
1290 | NotifyOt herApps(NA E_OPEN, In tToStr(Use r.DUZ)); | |
1291 | LoadUser Preference s; | |
1292 | GetBASta tus(User.D UZ,Patient .DFN); | |
1293 | Enabled := True; / / PaPI. Mo ved before mnuFileOp enClick to enable ma in window | |
1294 | mnuFileO penClick(S elf); | |
1295 | //Enable d := True; | |
1296 | // If Ti medOut, Cl ose has al ready been called. | |
1297 | if not T imedOut an d (Patient .DFN = '') then | |
1298 | Close | |
1299 | {$IFDEF PA PITEST} | |
1300 | else if getOpti onValue('R PCLOG') <> '' then | |
1301 | begin | |
1302 | Show Broker; | |
1303 | Swit chToThisWi ndow(Handl e,true); | |
1304 | end; | |
1305 | {$ELSE} | |
1306 | ; | |
1307 | {$ENDIF} | |
1308 | end; | |
1309 | ||
1310 | procedure TfrmFrame. FormDestro y(Sender: TObject); | |
1311 | { free cor e objects used by CP RS } | |
1312 | Var | |
1313 | I:integer ; | |
1314 | begin | |
1315 | Applicat ion.OnActi vate := FO ldActivate ; | |
1316 | Screen.O nActiveFor mChange := FOldActiv eFormChang e; | |
1317 | FNextBut tonBitmap. Free; | |
1318 | if FNext Button <> nil then F NextButton .Free; | |
1319 | uTabList .Free; | |
1320 | FlaggedP TList.Free ; | |
1321 | RemoteSi tes.Free; | |
1322 | RemoteRe ports.Free ; | |
1323 | Notifica tions.Free ; | |
1324 | Changes. Free; | |
1325 | Encounte r.Free; | |
1326 | Patient. Free; | |
1327 | User.Fre e; | |
1328 | SizeHold er.Free; | |
1329 | ctxConte xtor.Free; | |
1330 | frmDebug Report.Fre e; | |
1331 | ||
1332 | for I := high(Watc hArray) do wnto low(W atchArray) do | |
1333 | WatchA rray[I].RP CText.Free ; | |
1334 | SetLengt h(WatchArr ay, 0); | |
1335 | end; | |
1336 | ||
1337 | procedure TfrmFrame. ModalEnd(S ender: TOb ject); | |
1338 | begin | |
1339 | Halt; | |
1340 | end; | |
1341 | ||
1342 | procedure TfrmFrame. FormCloseQ uery(Sende r: TObject ; var CanC lose: Bool ean); | |
1343 | { cancels close if t he user ca ncels the ReviewChan ges screen } | |
1344 | var | |
1345 | Reason: string; | |
1346 | I: integ er; | |
1347 | SystemMo dal: Boole an; | |
1348 | begin | |
1349 | //check f or modal w indows and close any that may exist | |
1350 | if Applic ation.Moda lLevel > 0 then | |
1351 | begin | |
1352 | SystemMo dal := tru e; | |
1353 | // Scree n.ActiveFo rm.Close() ; | |
1354 | for i := Screen.Fo rmCount - 1 downto 1 do begin | |
1355 | if (fsM odal in Sc reen.Forms [i].FormSt ate) and ( Screen.For ms[i] <> A pplication .MainForm) then | |
1356 | begin | |
1357 | Scree n.Forms[i] .Close(); | |
1358 | Syste mModal := False; | |
1359 | end; | |
1360 | end; | |
1361 | ||
1362 | if Syste mModal the n | |
1363 | Applica tion.OnMod alEnd := M odalEnd; | |
1364 | end; | |
1365 | ||
1366 | if (FCre ateProgres s < FCP_FI NISH) then Exit; | |
1367 | if User. IsReportsO nly then / / Reports Only tab. | |
1368 | exit; | |
1369 | if Timed Out then | |
1370 | begin | |
1371 | if C hanges.Req uireReview then Revi ewChanges( TimedOut); | |
1372 | Exit ; | |
1373 | end; | |
1374 | if not A llowContex tChangeAll (Reason) t hen CanClo se := Fals e; | |
1375 | end; | |
1376 | ||
1377 | procedure TfrmFrame. SetUserToo ls; | |
1378 | var | |
1379 | item, pa rent: TToo lMenuItem; | |
1380 | ok: bool ean; | |
1381 | index, i , idx, cou nt: Intege r; | |
1382 | UserTool : TMenuIte m; | |
1383 | Menus: T StringList ; | |
1384 | begin | |
1385 | if User. IsReportsO nly then / / Reports Only tab. | |
1386 | begin | |
1387 | mnuToo ls.Clear; // Remove all curren t items. | |
1388 | UserTo ol := TMen uItem.Crea te(Self); | |
1389 | UserTo ol.Caption := 'Optio ns...'; | |
1390 | UserTo ol.Hint := 'Options' ; | |
1391 | UserTo ol.OnClick := mnuToo lsOptionsC lick; | |
1392 | mnuToo ls.Add(Use rTool); // Add back the "Optio ns" menu. | |
1393 | exit; | |
1394 | end; | |
1395 | if User. GECStatus then | |
1396 | begin | |
1397 | UserTo ol := TMen uItem.Crea te(self); | |
1398 | UserTo ol.Caption := 'GEC R eferral St atus Displ ay'; | |
1399 | UserTo ol.Hint := 'GEC Refe rral Statu s Display' ; | |
1400 | UserTo ol.OnClick := mnuGEC StatusClic k; | |
1401 | mnuToo ls.Add(Use rTool); // Add back the "Optio ns" menu. | |
1402 | end; | |
1403 | GetToolM enu; // Fo r all othe r users, p roceed nor mally with creation of Tools m enu: | |
1404 | for i := uToolMenu Items.Coun t-1 downto 0 do | |
1405 | begin | |
1406 | item : = TToolMen uItem(uToo lMenuItems [i]); | |
1407 | if (An siCompareT ext(item.C aption, 'E vent Captu re Interfa ce') = 0 ) and | |
1408 | (no t uECSRepo rt.ECSPerm it) then | |
1409 | begin | |
1410 | uToo lMenuItems .Delete(i) ; | |
1411 | Brea k; | |
1412 | end; | |
1413 | end; | |
1414 | Menus := TStringLi st.Create; | |
1415 | try | |
1416 | count := 0; | |
1417 | idx := 0; | |
1418 | index := 0; | |
1419 | while count < uT oolMenuIte ms.Count d o | |
1420 | begin | |
1421 | for I := 0 to uToolMenuI tems.Count - 1 do | |
1422 | begi n | |
1423 | it em := TToo lMenuItem( uToolMenuI tems[i]); | |
1424 | if assigned( item.MenuI tem) then continue; | |
1425 | if item.SubM enuID = '' then | |
1426 | ok := True | |
1427 | el se | |
1428 | be gin | |
1429 | idx := Men us.IndexOf (item.SubM enuID); | |
1430 | ok := (idx >= 0); | |
1431 | en d; | |
1432 | if ok then | |
1433 | be gin | |
1434 | inc(count) ; | |
1435 | UserTool : = TMenuIte m.Create(S elf); | |
1436 | UserTool.C aption := Item.Capti on; | |
1437 | if Item.Ac tion <> '' then | |
1438 | begin | |
1439 | UserTool .Hint := I tem.Action ; | |
1440 | UserTool .OnClick : = ToolClic k; | |
1441 | end; | |
1442 | Item.MenuI tem := Use rTool; | |
1443 | if item.Su bMenuID = '' then | |
1444 | begin | |
1445 | mnuTools .Insert(In dex,UserTo ol); | |
1446 | inc(Inde x); | |
1447 | end | |
1448 | else | |
1449 | begin | |
1450 | parent : = TToolMen uItem(Menu s.Objects[ idx]); | |
1451 | parent.M enuItem.Ad d(UserTool ); | |
1452 | end; | |
1453 | if item.Me nuID <> '' then | |
1454 | Menus.Ad dObject(it em.MenuID, item); | |
1455 | en d; | |
1456 | end; | |
1457 | end; | |
1458 | finally | |
1459 | Menus. Free; | |
1460 | end; | |
1461 | FreeAndN il(uToolMe nuItems); | |
1462 | end; | |
1463 | ||
1464 | procedure TfrmFrame. UpdateECSP arameter(v ar CmdPara meter: str ing); //E CS | |
1465 | var | |
1466 | vstID,Ac cVer,Svr,S vrPort,VUs er: string ; | |
1467 | begin | |
1468 | AccVer := ''; | |
1469 | Svr := ''; | |
1470 | SvrPort := ''; | |
1471 | VUser := ''; | |
1472 | if RPCBr okerV <> n il then | |
1473 | begin | |
1474 | AccVer := Strin g(RPCBroke rV.AccessV erifyCodes ); | |
1475 | Svr := Strin g(RPCBroke rV.Server) ; | |
1476 | SvrPor t := IntTo Str(RPCBro kerV.Liste nerPort); | |
1477 | VUser := RPCBr okerV.User .DUZ; | |
1478 | end; | |
1479 | vstID := GetVisitI D; | |
1480 | CmdParam eter :=' S vr=' +Svr | |
1481 | +' SvrPort='+ SvrPort | |
1482 | +' VUser='+ V User | |
1483 | +' PtIEN='+ P atient.DFN | |
1484 | +' PdIEN='+In tToStr(Enc ounter.Pro vider) | |
1485 | +' vstIEN='+v stID | |
1486 | +' locIEN='+I ntToStr(En counter.Lo cation) | |
1487 | +' Date=0' | |
1488 | +' Division=' +GetDivisi onID; | |
1489 | ||
1490 | end; | |
1491 | ||
1492 | procedure TfrmFrame. compAccess TabPageCap tionQuery( Sender: TO bject; | |
1493 | var Text : string); | |
1494 | begin | |
1495 | Text := GetTabText ; | |
1496 | end; | |
1497 | ||
1498 | function T frmFrame.V alidECSUse r: boolean ; //ECS | |
1499 | var | |
1500 | isTrue: boolean; | |
1501 | begin | |
1502 | Result : = True; | |
1503 | with RPC BrokerV do | |
1504 | begin | |
1505 | ShowEr rorMsgs := semQuiet; | |
1506 | Connec ted := True; | |
1507 | try | |
1508 | isTr ue := Crea teContext( TX_ECSOPT) ; | |
1509 | if n ot isTrue then | |
1510 | Re sult := Fa lse; | |
1511 | Show ErrorMsgs := semRais e; | |
1512 | except | |
1513 | on E : Exceptio n do | |
1514 | begi n | |
1515 | Sh owErrorMsg s := semRa ise; | |
1516 | Re sult := Fa lse; | |
1517 | end; | |
1518 | end; | |
1519 | end; | |
1520 | end; | |
1521 | ||
1522 | procedure TfrmFrame. FormClose( Sender: TO bject; var Action: T CloseActio n); | |
1523 | begin | |
1524 | FClosing := TRUE; | |
1525 | SetFormM onitoring( false); | |
1526 | If Assig ned(Patien t) then | |
1527 | CPAppMo n.SaveTheB uffer; //s ave the bu ffer | |
1528 | ||
1529 | ||
1530 | if FCrea teProgress < FCP_FIN ISH then F Terminate := True; | |
1531 | ||
1532 | FlushNot ifierBuffe r; | |
1533 | if FCrea teProgress = FCP_FIN ISH then N otifyOther Apps(NAE_C LOSE, ''); | |
1534 | Terminat eOtherAppN otificatio n; | |
1535 | ||
1536 | if Graph Float <> n il then | |
1537 | begin | |
1538 | if frm Frame.Grap hFloatActi ve then | |
1539 | Grap hFloat.Clo se; | |
1540 | GraphF loat.Relea se; | |
1541 | end; | |
1542 | ||
1543 | // unhoo k the time out hooks | |
1544 | ShutDown TimeOut; | |
1545 | // clear ing change s will unl ock notes | |
1546 | if FCrea teProgress = FCP_FIN ISH then C hanges.Cle ar; | |
1547 | // clear server si de flag gl obal tmp | |
1548 | if FCrea teProgress = FCP_FIN ISH then C learFlag; | |
1549 | // save user prefe rences | |
1550 | if FCrea teProgress = FCP_FIN ISH then S aveUserPre ferences; | |
1551 | // call close for each page in case th ere is any special p rocessing | |
1552 | if FCrea teProgress > FCP_FOR MS then | |
1553 | begin | |
1554 | mnuFra me.Merge(n il); | |
1555 | frmCov erSheet.Cl ose; | |
1556 | frmPro blems.Clos e; //frm Problems.R elease; | |
1557 | frmMed s.Close; //frm Meds.Relea se; | |
1558 | frmOrd ers.Close; //frm Orders.Rel ease; | |
1559 | frmNot es.Close; //frm Notes.Rele ase; | |
1560 | frmCon sults.Clos e; //frm Consults.R elease; | |
1561 | frmDCS umm.Close; //frm DCSumm.Rel ease; | |
1562 | if Ass igned(frmS urgery) th en frmSurg ery.Close; //frmS urgery.Rel ease; | |
1563 | frmLab s.Close; //frm Labs.Relea se; | |
1564 | frmRep orts.Close ; //frm Reports.Re lease; | |
1565 | frmGra phData.Clo se; //frm GraphData. Release; | |
1566 | ||
1567 | end; | |
1568 | ||
1569 | RPCLogCl ose; | |
1570 | ||
1571 | // if < FCP_FINISH we came h ere from i nside Form Create, so need to c all termin ate | |
1572 | if FCrea teProgress < FCP_FIN ISH then A pplication .Terminate ; | |
1573 | end; | |
1574 | ||
1575 | procedure TfrmFrame. SetDebugMe nu; | |
1576 | var | |
1577 | IsProgra mmer: Bool ean; | |
1578 | begin | |
1579 | IsProgra mmer := Us er.HasKey( 'XUPROGMOD E') or (Sh owRPCList = True); | |
1580 | mnuHelpB roker.Visi ble := I sProgramme r; | |
1581 | mnuHelpL ists.Visib le := I sProgramme r; | |
1582 | mnuHelpS ymbols.Vis ible := I sProgramme r; | |
1583 | mnuFocus Changes.Vi sible := I sProgramme r; {added 10 May 20 12 dlp se e fFocusCo ntrols } | |
1584 | Z6.Visib le := I sProgramme r; | |
1585 | RPCLog_S aveAvailab le := isPr ogrammer; | |
1586 | end; | |
1587 | ||
1588 | { Updates posted to MainForm - ---------- ---------- ---------- ---------- ---------- ---------- -- } | |
1589 | ||
1590 | procedure TfrmFrame. UMNewOrder (var Messa ge: TMessa ge); | |
1591 | { post a n otice of c hange in o rders to a ll TPages, wParam=Or derAction, lParam=TO rder } | |
1592 | var | |
1593 | OrderAct : string; | |
1594 | begin | |
1595 | with Mes sage do | |
1596 | begin | |
1597 | CoverS heet.OnRef reshPanel( Self, CV_C PRS_ALLG); | |
1598 | CoverS heet.OnRef reshPanel( Self, CV_C PRS_POST); | |
1599 | frmPro blems.Noti fyOrder(WP aram, TOrd er(LParam) ); | |
1600 | frmMed s.NotifyOr der(WParam , TOrder(L Param)); | |
1601 | frmOrd ers.Notify Order(WPar am, TOrder (LParam)); | |
1602 | frmNot es.NotifyO rder(WPara m, TOrder( LParam)); | |
1603 | frmCon sults.Noti fyOrder(WP aram, TOrd er(LParam) ); | |
1604 | frmDCS umm.Notify Order(WPar am, TOrder (LParam)); | |
1605 | if Ass igned(frmS urgery) th en frmSurg ery.Notify Order(WPar am, TOrder (LParam)); | |
1606 | frmLab s.NotifyOr der(WParam , TOrder(L Param)); | |
1607 | frmRep orts.Notif yOrder(WPa ram, TOrde r(LParam)) ; | |
1608 | lblPtC WAD.Captio n := GetCW ADInfo(Pat ient.DFN); | |
1609 | if Len gth(lblPtC WAD.Captio n) > 0 the n | |
1610 | lblP tPostings. Caption := 'Postings ' | |
1611 | else | |
1612 | lblP tPostings. Caption := 'No Posti ngs'; | |
1613 | pnlPos tings.Capt ion := lbl PtPostings .Caption + ' ' + lbl PtCWAD.Cap tion; | |
1614 | OrderA ct := ''; | |
1615 | case W Param of | |
1616 | ORDE R_NEW: O rderAct := 'NW'; | |
1617 | ORDE R_DC: O rderAct := 'DC'; | |
1618 | ORDE R_RENEW: O rderAct := 'RN'; | |
1619 | ORDE R_HOLD: O rderAct := 'HD'; | |
1620 | ORDE R_EDIT: O rderAct := 'XX'; | |
1621 | ORDE R_ACT: O rderAct := 'AC'; | |
1622 | end; | |
1623 | if Len gth(OrderA ct) > 0 th en NotifyO therApps(N AE_ORDER, OrderAct + U + TOrde r(LParam). ID); // a dd FillerI D | |
1624 | end; | |
1625 | end; | |
1626 | ||
1627 | procedure TfrmFrame. UMReminder s(var Mess age: TMess age); | |
1628 | begin | |
1629 | CoverShe et.OnRefre shPanel(Se lf, CV_CPR S_WVHT); | |
1630 | CoverShe et.OnRefre shPanel(Se lf, CV_CPR S_POST); | |
1631 | CoverShe et.onRefre shPanel(Se lf, CV_CPR S_RMND); | |
1632 | // CoverS heet.OnRef reshCWAD(S elf); | |
1633 | lblPtCWA D.Caption := GetCWAD Info(Patie nt.DFN); | |
1634 | if Lengt h(lblPtCWA D.Caption) > 0 then | |
1635 | lblPtP ostings.Ca ption := ' Postings' | |
1636 | else | |
1637 | lblPtP ostings.Ca ption := ' No Posting s'; | |
1638 | pnlPosti ngs.Captio n := lblPt Postings.C aption + ' ' + lblPt CWAD.Capti on; | |
1639 | end; | |
1640 | ||
1641 | { Tab Sele ction (nav igate betw een pages) --------- ---------- ---------- ---------- ---------- -- } | |
1642 | ||
1643 | procedure TfrmFrame. WMSetFocus (var Messa ge: TMessa ge); | |
1644 | var | |
1645 | aCPRS508 : ICPRS508 ; | |
1646 | begin | |
1647 | if (FLas tPage <> n il) and (n ot TimedOu t) and | |
1648 | (not (csDestroy ing in FLa stPage.Com ponentStat e)) and FL astPage.Vi sible then | |
1649 | if FL astPage.In heritsFrom (TfrmPage) then | |
1650 | Tfr mPage(FLas tPage).Foc usFirstCon trol | |
1651 | else if Support s(fLastPag e, ICPRS50 8, aCPRS50 8) then | |
1652 | aCP RS508.OnFo cusFirstCo ntrol(Self ); | |
1653 | end; | |
1654 | ||
1655 | procedure TfrmFrame. UMShowPage (var Messa ge: TMessa ge); | |
1656 | { shows a page when the UM_SHO WPAGE mess age is rec eived } | |
1657 | var | |
1658 | aCPRSTab : ICPRSTab ; | |
1659 | begin | |
1660 | if FCCOW DrivedChan ge then FC COWDrivedC hange := F alse; | |
1661 | ||
1662 | if FLast Page <> ni l then | |
1663 | if FLa stPage.Inh eritsFrom( TfrmPage) then | |
1664 | Tfrm Page(FLast Page).Disp layPage | |
1665 | else i f Supports (fLastPage , ICPRSTab , aCPRSTab ) then | |
1666 | aCPR STab.OnDis playPage(S elf, CC_CL ICK); | |
1667 | ||
1668 | FChangeS ource := C C_CLICK; // reset t o click so we're onl y dealing with excep tions to c lick | |
1669 | if assig ned(FTabCh anged) the n | |
1670 | FTabCh anged(Self ); | |
1671 | end; | |
1672 | ||
1673 | procedure TfrmFrame. SwitchToPa ge(NewForm : TForm); | |
1674 | { unmerge/ merge menu s, bring p age to top of z-orde r, call fo rm-specifi c OnDispla y code } | |
1675 | begin | |
1676 | if FLast Page = New Form then | |
1677 | begin | |
1678 | if N otificatio ns.Active and Assign ed(NewForm ) then Pos tMessage(H andle, UM_ SHOWPAGE, 0, 0); | |
1679 | Exit ; | |
1680 | end; | |
1681 | if (FLas tPage <> n il) then | |
1682 | begin | |
1683 | mnuFra me.Unmerge (FLastPage .Menu); | |
1684 | FLastP age.Hide; | |
1685 | end; | |
1686 | if Assig ned(NewFor m) then be gin | |
1687 | mnuFra me.Merge(N ewForm.Men u); | |
1688 | NewFor m.Show; | |
1689 | end; | |
1690 | lstCIRNL ocations.V isible := False; | |
1691 | pnlCIRN. BevelOuter := bvRais ed; | |
1692 | lstCIRNL ocations.S endToBack; | |
1693 | mnuFileP rint.Enabl ed := Fals e; // let individual page enab le this | |
1694 | mnuFileP rintSetup. Enabled := False; // let individual page enab le this | |
1695 | mnuFileP rintSelect edItems.En abled := F alse; | |
1696 | FLastPag e := NewFo rm; | |
1697 | if NewFo rm <> nil then | |
1698 | begin | |
1699 | if New Form.Name = frmNotes .Name then frmNotes. Align := a lClient | |
1700 | else frmNotes. Align := a lNone; | |
1701 | if New Form.Name = frmConsu lts.Name t hen frmCon sults.Alig n := alCli ent | |
1702 | else frmConsul ts.Align : = alNone; | |
1703 | if New Form.Name = frmRepor ts.Name th en frmRepo rts.Align := alClien t | |
1704 | else frmReport s.Align := alNone; | |
1705 | if New Form.Name = frmDCSum m.Name the n frmDCSum m.Align := alClient | |
1706 | else frmDCSumm .Align := alNone; | |
1707 | if Ass igned(frmS urgery) th en | |
1708 | if N ewForm.Nam e = frmSur gery.Name then frmSu rgery.Alig n := alcli ent | |
1709 | el se frmSurg ery.Align := alNone; | |
1710 | NewFor m.BringToF ront; // to cause tab switch to happen im mediately | |
1711 | Applic ation.Proc essMessage s; | |
1712 | PostMe ssage(Hand le, UM_SHO WPAGE, 0, 0); // th is calls D isplayPage for the f orm | |
1713 | end; | |
1714 | end; | |
1715 | ||
1716 | procedure TfrmFrame. mnuDebugRe portClick( Sender: TO bject); | |
1717 | begin | |
1718 | inherite d; | |
1719 | if not A ssigned(fr mDebugRepo rt) then f rmDebugRep ort := Tfr mDebugRepo rt.Create( self); | |
1720 | frmDebu gReport.Sh ow; | |
1721 | end; | |
1722 | ||
1723 | procedure TfrmFrame. mnuChartTa bClick(Sen der: TObje ct); | |
1724 | { use the Tag proper ty of the menu item to switch to proper page } | |
1725 | begin | |
1726 | with Sen der as TMe nuItem do tabPage.Ta bIndex := PageIDToTa b(Tag); | |
1727 | LastTab := TabToPa geID(tabPa ge.TabInde x) ; | |
1728 | tabPageC hange(tabP age); | |
1729 | end; | |
1730 | ||
1731 | procedure TfrmFrame. tabPageCha nge(Sender : TObject) ; | |
1732 | { switches to form l inked to N ewTab } | |
1733 | var | |
1734 | PageID : integer; | |
1735 | begin | |
1736 | PageID : = TabToPag eID((sende r as TTabC ontrol).Ta bIndex); | |
1737 | if (Page ID <> CT_N OPAGE) and (TabPage. CanFocus) and Assign ed(FLastPa ge) and | |
1738 | (not TabPage.Fo cused) the n | |
1739 | TabPag e.SetFocus ; //CQ: 1 4854 | |
1740 | if (not User.IsRep ortsOnly) then | |
1741 | begin | |
1742 | case P ageID of | |
1743 | CT_N OPAGE: S witchToPag e(nil); | |
1744 | CT_C OVER: S witchToPag e(frmCover Sheet); | |
1745 | CT_P ROBLEMS: S witchToPag e(frmProbl ems); | |
1746 | CT_M EDS: S witchToPag e(frmMeds) ; | |
1747 | CT_O RDERS: S witchToPag e(frmOrder s); | |
1748 | CT_N OTES: S witchToPag e(frmNotes ); | |
1749 | CT_C ONSULTS: S witchToPag e(frmConsu lts); | |
1750 | CT_D CSUMM: S witchToPag e(frmDCSum m); | |
1751 | CT_S URGERY: S witchToPag e(frmSurge ry); | |
1752 | CT_L ABS: S witchToPag e(frmLabs) ; | |
1753 | CT_R EPORTS: S witchToPag e(frmRepor ts); | |
1754 | end; { case} | |
1755 | end | |
1756 | else // Reports On ly tab. | |
1757 | Switch ToPage(frm Reports); | |
1758 | if Scree nReaderSys temActive and FCtrlT abUsed the n | |
1759 | SpeakP atient; | |
1760 | Changing Tab := Pag eID; | |
1761 | end; | |
1762 | ||
1763 | function T frmFrame.P ageIDToTab (PageID: I nteger): I nteger; | |
1764 | { returns the tab in dex that c orresponds to a give n PageID } | |
1765 | VAR | |
1766 | i: integ er; | |
1767 | begin | |
1768 | i := uT abList.Ind exOf(IntTo Str(PageID )); | |
1769 | Result : = i; | |
1770 | end; | |
1771 | ||
1772 | function T frmFrame.T abToPageID (Tab: Inte ger): Inte ger; | |
1773 | { returns the consta nt that id entifies t he page gi ven a TabI ndex } | |
1774 | begin | |
1775 | if (Tab > -1) and (Tab < uTa bList.Coun t) then | |
1776 | Result := StrToI ntDef(uTab List[Tab], CT_UNKNOW N) | |
1777 | else | |
1778 | Result := CT_NOP AGE; | |
1779 | end; | |
1780 | ||
1781 | { File Men u Events - ---------- ---------- ---------- ---------- ---------- ---------- ---------- -- } | |
1782 | ||
1783 | procedure TfrmFrame. SetupPatie nt(AFlagge dList : TS tringList) ; | |
1784 | var | |
1785 | AMsg, Se lectMsg: s tring; | |
1786 | ShortStr , | |
1787 | LongStr1 , LongStr2 , | |
1788 | LocalMsg : String; // rpk 2/ 28/2018 | |
1789 | begin | |
1790 | with Pat ient do | |
1791 | begin | |
1792 | ClearP atient; / / must be called to avoid leav ing previo us patient 's informa tion visib le! | |
1793 | btnCom batVet.Cap tion := 'C V '+ Comba tVet.Expir ationDate; | |
1794 | btnCom batVet.Vis ible := Pa tient.Comb atVet.IsEl igible; | |
1795 | Visibl e := True; | |
1796 | Applic ation.Proc essMessage s; | |
1797 | lblPtN ame.Captio n := Name + Status; //CQ #1749 1: Allow f or the dis play of th e patient status ind icator in header bar . | |
1798 | lblPtS SN.Caption := SSN; | |
1799 | lblPtA ge.Caption := Format FMDateTime ('mmm dd,y yyy', DOB) + ' (' + IntToStr(A ge) + ')'; | |
1800 | pnlPat ient.Capti on := lblP tName.Capt ion + ' ' + lblPtSSN .Caption + ' ' + lbl PtAge.Capt ion; | |
1801 | ||
1802 | if get OTHD(Patie nt.DFN, Pa tient.Name , ShortStr , Longstr1 , LongStr2 , LocalMsg ) then beg in // rpk 1/2/2018 | |
1803 | pnlO THD.Show; // rpk 12/ 6/2017 | |
1804 | pnlO THD.Enable d := True; // rpk 12 /6/2017 | |
1805 | pnlO THD.TabSto p := True; // rpk 1/ 18/2018 | |
1806 | lblO THD.Enable d := True; // rpk 1/ 2/2018 | |
1807 | lblO THDTitle.E nabled := True; // rpk 12/6/2 017 | |
1808 | pnlO THD.Hint : = 'Other t han Honora ble: ' + L ongStr1 + CRLF + Lon gStr2; | |
1809 | if L ocalMsg > '' then | |
1810 | pn lOTHD.Hint := pnlOTH D.Hint + C RLF + Loca lMsg; // rpk 2/28/2 018 | |
1811 | OTHD ShortStr : = ShortStr ; | |
1812 | OTHD LongStr1 : = LongStr1 ; | |
1813 | OTHD LongStr2 : = LongStr2 ; | |
1814 | OTHD LocalMsg : = LocalMsg ; // rpk 2/28/2018 | |
1815 | if S creenReade rActive th en begin // rpk 1/2 /2018 | |
1816 | lb lOTHD.Capt ion := Lon gStr1 + ' ' + LongSt r2; | |
1817 | end | |
1818 | else begin | |
1819 | lb lOTHD.TabS top := Fal se; | |
1820 | lb lOTHD.Capt ion := Sho rtstr; // rpk 12/6/2 017 | |
1821 | lb lOTHD.Hint := LongSt r1 + CRLF + LongStr2 ; | |
1822 | end; | |
1823 | end; / / rpk 1/2/ 2018 | |
1824 | ||
1825 | if Len gth(CWAD) > 0 | |
1826 | then lblPtPost ings.Capti on := 'Pos tings' | |
1827 | else lblPtPost ings.Capti on := 'No Postings'; | |
1828 | lblPtC WAD.Captio n := CWAD; | |
1829 | pnlPos tings.Capt ion := lbl PtPostings .Caption + ' ' + lbl PtCWAD.Cap tion; | |
1830 | if (Le ngth(Prima ryTeam) > 0) or (Len gth(Primar yProvider) > 0) then | |
1831 | begin | |
1832 | lblP tCare.Capt ion := Pri maryTeam; | |
1833 | if P rimaryProv ider <> '' then lblP tCare.Capt ion := lbl PtCare.Cap tion + ' / ' + Mixed Case(Prima ryProvider ); | |
1834 | if L ength(Asso ciate)>0 t hen lblPtC are.Captio n := lblP tCare.Capt ion + ' / ' + MixedC ase(Associ ate); | |
1835 | end; | |
1836 | if Len gth(Attend ing) > 0 t hen lblPtA ttending.C aption := '(Inpatien t) Attendi ng: ' + M ixedCase(A ttending); | |
1837 | pnlPri maryCare.C aption := lblPtCare. Caption + ' ' + lblP tAttending .Caption; | |
1838 | if Len gth(InProv ider) > 0 then lblP tAttending .Caption : = lblPtAtt ending.Cap tion + ' - (Inpatien t) Provide r: ' + Mix edCase(InP rovider); | |
1839 | if Len gth(MHTC) > 0 then l blPtMHTC.C aption := 'MH Treatm ent Coordi nator: ' + MixedCase (MHTC); | |
1840 | if (Le ngth(MHTC) = 0) and (Inpatient = True) a nd (Specia ltySvc = ' P') then | |
1841 | lblP tMHTC.Capt ion := 'MH Treatment Coordinat or Unassig ned'; | |
1842 | pnlPri maryCare.C aption := lblPtCare. Caption + ' ' + lblP tAttending .Caption + ' ' + lbl PtMHTC.Cap tion; | |
1843 | SetUpC IRN; | |
1844 | Displa yEncounter Text; | |
1845 | SetSha reNode(DFN , Handle); | |
1846 | with P atient do | |
1847 | Noti fyOtherApp s(NAE_NEWP T, SSN + U + FloatTo Str(DOB) + U + Name) ; | |
1848 | Select Msg := ''; | |
1849 | if Mea nsTestRequ ired(Patie nt.DFN, AM sg) then S electMsg : = AMsg; | |
1850 | if Has LegacyData (Patient.D FN, AMsg) then S electMsg : = SelectMs g + CRLF + AMsg; | |
1851 | ||
1852 | HasAct iveFlg(Fla gList, Has Flag, Pati ent.DFN); | |
1853 | if Has Flag then begin | |
1854 | txtC mdFlags.Vi sible := f alse; | |
1855 | pnlF lag.Enable d := True; | |
1856 | lblF lag.Font.C olor := Ge t508Compli antColor(c lMaroon); | |
1857 | lblF lag.Enable d := True; | |
1858 | if ( not FReFre shing) and (TriggerP RFPopUp(Pa tient.DFN) ) then | |
1859 | Sh owFlags; | |
1860 | end el se begin | |
1861 | txtC mdFlags.Vi sible := S creenReade rSystemAct ive; | |
1862 | pnlF lag.Enable d := False ; | |
1863 | lblF lag.Font.C olor := cl BtnFace; | |
1864 | lblF lag.Enable d := False ; | |
1865 | end; | |
1866 | FPrevP tID := pat ient.DFN; | |
1867 | { frmC over.Updat eVAAButton ; //VAA CQ 7525 (mov ed here in v26.30 (R V))} | |
1868 | Update VAAMHVButt ons(nil); | |
1869 | pnlOTH D.Left := paVAA.Left - pnlOTHD .Width; / / reset OT H button t o left of VAA, rpk 8 /3/2018 | |
1870 | Proces sPatientCh angeEventH ook; | |
1871 | if Len gth(Select Msg) > 0 t hen ShowPa tientSelec tMessages( SelectMsg) ; | |
1872 | end; | |
1873 | end; // S etupPatien t | |
1874 | ||
1875 | procedure TfrmFrame. mnuFileNex tClick(Sen der: TObje ct); | |
1876 | var | |
1877 | SaveDFN, NewDFN: s tring; // *DFN* | |
1878 | NextInde x: Integer ; | |
1879 | Reason: string; | |
1880 | CCOWResp onse: User Response; | |
1881 | AccessSt atus: inte ger; | |
1882 | ||
1883 | proced ure Update PatientInf oForAlert; | |
1884 | begin | |
1885 | if P atient.Inp atient the n begin | |
1886 | En counter.In patient := True; | |
1887 | En counter.Lo cation := Patient.Lo cation; | |
1888 | En counter.Da teTime := Patient.Ad mitTime; | |
1889 | En counter.Vi sitCategor y := 'H'; | |
1890 | end; | |
1891 | if U ser.IsProv ider then Encounter. Provider : = User.DUZ ; | |
1892 | Setu pPatient(F laggedPTLi st); | |
1893 | if ( FlaggedPTL ist.IndexO f(Patient. DFN) < 0) then | |
1894 | Fl aggedPTLis t.Add(Pati ent.DFN); | |
1895 | end; | |
1896 | ||
1897 | proced ure report Notificati onFollowUp Text; | |
1898 | var | |
1899 | sl: TStrings; | |
1900 | begin | |
1901 | sl : = TStringL ist.Create ; | |
1902 | try | |
1903 | se tNotificat ionFollowU pText(sl, Patient.DF N, Notific ations.Fol lowUp, | |
1904 | Notificati ons.AlertD ata); | |
1905 | Re portBox(sl , Pieces(P iece(Notif ications.R ecordID, U , 1), ':', 2, | |
1906 | 3), True); | |
1907 | fina lly | |
1908 | sl .Free; | |
1909 | end; | |
1910 | end; | |
1911 | ||
1912 | begin | |
1913 | DoNotCha ngeEncWind ow := Fals e; | |
1914 | OrderPri ntForm := False; | |
1915 | mnuFile. Tag := 0; | |
1916 | SaveDFN := Patient .DFN; | |
1917 | Notifica tions.Next ; | |
1918 | if Notif ications.A ctive then | |
1919 | begin | |
1920 | NewDFN := Notifi cations.DF N; | |
1921 | if Sav eDFN <> Ne wDFN then | |
1922 | begin | |
1923 | // n ewdfn does not have new patien t.co infor mation for CCOW call | |
1924 | if ( (Sender = mnuFileOpe n) or (All owContextC hangeAll(R eason))) | |
1925 | and AllowA ccessToSen sitivePati ent(NewDFN , AccessSt atus) then | |
1926 | begi n | |
1927 | Re mindersSta rted := FA LSE; | |
1928 | Pa tient.DFN := NewDFN; | |
1929 | En counter.Cl ear; | |
1930 | Ch anges.Clea r; | |
1931 | if Assigned( FlagList) then | |
1932 | be gin | |
1933 | F lagList.Cl ear; | |
1934 | H asFlag := False; | |
1935 | H asActiveFl g(FlagList , HasFlag, NewDFN); | |
1936 | en d; | |
1937 | if FCCOWInst alled and (ctxContex tor.State = csPartic ipating) t hen | |
1938 | begin | |
1939 | if (Allo wCCOWConte xtChange(C COWRespons e, Patient .DFN)) the n | |
1940 | Update PatientInf oForAlert | |
1941 | else | |
1942 | begin | |
1943 | case CCOWRespo nse of | |
1944 | ur Cancel: | |
1945 | begin | |
1946 | Patient. DFN := Sav eDFN; | |
1947 | Notifica tions.Prio r; | |
1948 | Exit; | |
1949 | end; | |
1950 | ur Break: | |
1951 | begin | |
1952 | // do no t revert t o old DFN if context was manua lly broken by user - v26 (RV) | |
1953 | if (ctxC ontextor.S tate = csP articipati ng) then P atient.DFN := SaveDF N; | |
1954 | UpdatePa tientInfoF orAlert; | |
1955 | end; | |
1956 | el se | |
1957 | UpdatePati entInfoFor Alert; | |
1958 | end; | |
1959 | end; | |
1960 | end | |
1961 | el se | |
1962 | UpdatePati entInfoFor Alert | |
1963 | end else | |
1964 | begi n | |
1965 | if AccessSta tus in [DG SR_ASK, DG SR_DENY] t hen | |
1966 | be gin | |
1967 | Notificati ons.Clear; | |
1968 | // hide th e 'next no tification ' button | |
1969 | FNextButto nActive := False; | |
1970 | FNextButto n.Free; | |
1971 | FNextButto n := nil; | |
1972 | mnuFileNex t.Enabled := False; | |
1973 | mnuFileNot ifRemove.E nabled := False; | |
1974 | Patient.DF N := ''; | |
1975 | mnuFileOpe nClick(mnu FileNext); | |
1976 | exit; | |
1977 | en d | |
1978 | el se | |
1979 | if SaveDFN < > '' then | |
1980 | be gin | |
1981 | Patient.DF N := SaveD FN; | |
1982 | Notificati ons.Prior; | |
1983 | Exit; | |
1984 | en d | |
1985 | el se | |
1986 | be gin | |
1987 | Notificati ons.Clear; | |
1988 | Patient.DF N := ''; | |
1989 | mnuFileOpe nClick(mnu FileNext); | |
1990 | exit; | |
1991 | en d; | |
1992 | end; | |
1993 | end; | |
1994 | stsAre a.Panels.I tems[1].Te xt := Noti fications. Text; | |
1995 | FChang eSource := CC_NOTIFI CATION; | |
1996 | NextIn dex := Pag eIDToTab(C T_COVER); | |
1997 | tabPag e.TabIndex := CT_NOP AGE; | |
1998 | tabPag eChange(ta bPage); | |
1999 | mnuFil eNotifRemo ve.Enabled := Notifi cations.Fo llowup in [NF_FLAGGE D_ORDERS, | |
2000 | NF_ORDER_ REQUIRES_E LEC_SIGNAT URE, | |
2001 | NF_MEDICA TIONS_EXPI RING_INPT, | |
2002 | NF_MEDICA TIONS_EXPI RING_OUTPT , | |
2003 | NF_UNVERI FIED_MEDIC ATION_ORDE R, | |
2004 | NF_UNVERI FIED_ORDER , | |
2005 | NF_FLAGGE D_OI_EXP_I NPT, | |
2006 | NF_FLAGGE D_OI_EXP_O UTPT]; | |
2007 | case N otificatio ns.FollowU p of | |
2008 | NF_L AB_RESULTS : NextIndex := PageID ToTab(CT_L ABS); | |
2009 | NF_F LAGGED_ORD ERS : NextIndex := PageID ToTab(CT_O RDERS); | |
2010 | NF_O RDER_REQUI RES_ELEC_S IGNATURE : NextIndex := PageID ToTab(CT_O RDERS); | |
2011 | NF_A BNORMAL_LA B_RESULTS : NextIndex := PageID ToTab(CT_L ABS); | |
2012 | NF_I MAGING_RES ULTS : NextIndex := PageID ToTab(CT_R EPORTS); | |
2013 | NF_C ONSULT_REQ UEST_RESOL UTION : NextIndex := PageID ToTab(CT_C ONSULTS); | |
2014 | NF_A BNORMAL_IM AGING_RESU LTS : NextIndex := PageID ToTab(CT_R EPORTS); | |
2015 | NF_I MAGING_REQ UEST_CANCE L_HELD : NextIndex := PageID ToTab(CT_O RDERS); | |
2016 | NF_N EW_SERVICE _CONSULT_R EQUEST : NextIndex := PageID ToTab(CT_C ONSULTS); | |
2017 | NF_C ONSULT_REQ UEST_CANCE L_HOLD : NextIndex := PageID ToTab(CT_C ONSULTS); | |
2018 | NF_P ROSTHETICS _REQUEST_U PDATED : NextIndex := PageID ToTab(CT_C ONSULTS); | |
2019 | NF_S ITE_FLAGGE D_RESULTS : NextIndex := PageID ToTab(CT_O RDERS); | |
2020 | NF_O RDERER_FLA GGED_RESUL TS : NextIndex := PageID ToTab(CT_O RDERS); | |
2021 | NF_O RDER_REQUI RES_COSIGN ATURE : NextIndex := PageID ToTab(CT_O RDERS); | |
2022 | NF_L AB_ORDER_C ANCELED : NextIndex := PageID ToTab(CT_O RDERS); | |
2023 | NF_S TAT_RESULT S : | |
2024 | if Piece(Pie ce(Notific ations.Ale rtData, '| ', 2), '@' , 2) = 'LR CH' then | |
2025 | NextIndex := PageIDT oTab(CT_LA BS) | |
2026 | el se if Piec e(Piece(No tification s.AlertDat a, '|', 2) , '@', 2) = 'GMRC' t hen | |
2027 | NextIndex := PageIDT oTab(CT_CO NSULTS) | |
2028 | el se if Piec e(Piece(No tification s.AlertDat a, '|', 2) , '@', 2) = 'RA' the n | |
2029 | NextIndex := PageIDT oTab(CT_RE PORTS); | |
2030 | NF_D NR_EXPIRIN G : NextIndex := PageID ToTab(CT_O RDERS); | |
2031 | NF_M EDICATIONS _EXPIRING_ INPT : NextIndex := PageID ToTab(CT_O RDERS); | |
2032 | NF_M EDICATIONS _EXPIRING_ OUTPT : NextIndex := PageID ToTab(CT_O RDERS); | |
2033 | NF_U NVERIFIED_ MEDICATION _ORDER : NextIndex := PageID ToTab(CT_O RDERS); | |
2034 | NF_R X_RENEWAL_ REQUEST : | |
2035 | be gin | |
2036 | if (Notifi cations.Al ertData = '') then | |
2037 | begin | |
2038 | Notifica tions.Dele te; | |
2039 | end; | |
2040 | NextIndex := PageIDT oTab(CT_OR DERS); | |
2041 | en d; | |
2042 | NF_L APSED_ORDE R : NextIndex := PageID ToTab(CT_O RDERS); | |
2043 | NF_N EW_ALLERGY _CONFLICT_ ORDER : NextIndex := PageID ToTab(CT_O RDERS); // NJC | |
2044 | NF_H IRISK_ORDE R : NextIndex := PageID ToTab(CT_O RDERS); | |
2045 | NF_N EW_ORDER : NextIndex := PageID ToTab(CT_O RDERS); | |
2046 | NF_I MAGING_RES ULTS_AMEND ED : NextIndex := PageID ToTab(CT_R EPORTS); | |
2047 | NF_C RITICAL_LA B_RESULTS : NextIndex := PageID ToTab(CT_L ABS); | |
2048 | NF_U NVERIFIED_ ORDER : NextIndex := PageID ToTab(CT_O RDERS); | |
2049 | NF_F LAGGED_OI_ RESULTS : NextIndex := PageID ToTab(CT_O RDERS); | |
2050 | NF_F LAGGED_OI_ ORDER : NextIndex := PageID ToTab(CT_O RDERS); | |
2051 | NF_F LAGGED_ORD ERS_COMMEN TS : NextIndex := PageID ToTab(CT_O RDERS); // NSR#20110 719 | |
2052 | NF_D C_ORDER : NextIndex := PageID ToTab(CT_O RDERS); | |
2053 | NF_D EA_AUTO_DC _CS_MED_OR DER : NextIndex := PageID ToTab(CT_O RDERS); | |
2054 | NF_D EA_CERT_RE VOKED : NextIndex := PageID ToTab(CT_O RDERS); | |
2055 | NF_C ONSULT_UNS IGNED_NOTE : NextIndex := PageID ToTab(CT_C ONSULTS); | |
2056 | NF_D CSUMM_UNSI GNED_NOTE : NextIndex := PageID ToTab(CT_D CSUMM); | |
2057 | NF_N OTES_UNSIG NED_NOTE : NextIndex := PageID ToTab(CT_N OTES); | |
2058 | NF_C ONSULT_REQ UEST_UPDAT ED : NextIndex := PageID ToTab(CT_C ONSULTS); | |
2059 | NF_F LAGGED_OI_ EXP_INPT : NextIndex := PageID ToTab(CT_O RDERS); | |
2060 | NF_F LAGGED_OI_ EXP_OUTPT : NextIndex := PageID ToTab(CT_O RDERS); | |
2061 | NF_C ONSULT_PRO C_INTERPRE TATION : NextIndex := PageID ToTab(CT_C ONSULTS); | |
2062 | NF_I MAGING_REQ UEST_CHANG ED : | |
2063 | be gin | |
2064 | ReportNoti ficationFo llowUpText ; | |
2065 | Notificati ons.Delete ; | |
2066 | en d; | |
2067 | NF_L AB_THRESHO LD_EXCEEDE D : NextIndex := PageID ToTab(CT_L ABS); | |
2068 | NF_M AMMOGRAM_R ESULTS : NextIndex := PageID ToTab(CT_R EPORTS); | |
2069 | NF_P AP_SMEAR_R ESULTS : NextIndex := PageID ToTab(CT_R EPORTS); | |
2070 | NF_A NATOMIC_PA THOLOGY_RE SULTS : NextIndex := PageID ToTab(CT_R EPORTS); | |
2071 | NF_S URGERY_UNS IGNED_NOTE : if TabExi sts(CT_SUR GERY) then | |
2072 | NextInd ex := Page IDToTab(CT _SURGERY) | |
2073 | else | |
2074 | InfoBox (TX_NO_SUR G_NOTIF, T C_NO_SURG_ NOTIF, MB_ OK); | |
2075 | ||
2076 | else | |
2077 | begin | |
2078 | if I sSmartAler t(Notifica tions.Foll owUp) then NextIndex := PageID ToTab(CT_N OTES) | |
2079 | else InfoBox(T X_UNK_NOTI F, TC_UNK_ NOTIF, MB_ OK); | |
2080 | end; | |
2081 | end; / /case | |
2082 | ||
2083 | tabPag e.TabIndex := NextIn dex; | |
2084 | tabPag eChange(ta bPage); | |
2085 | ||
2086 | end | |
2087 | else mnu FileOpenCl ick(mnuFil eNext); // case else | |
2088 | end; | |
2089 | ||
2090 | procedure TfrmFrame. SetBADxLis t; | |
2091 | var | |
2092 | i: small int; | |
2093 | begin | |
2094 | if not A ssigned(UB AGlobals.t empDxList) then | |
2095 | begin | |
2096 | UBAGl obals.temp DxList := TList.Crea te; | |
2097 | UBAGl obals.temp DxList.Cou nt := 0; | |
2098 | Appli cation.Pro cessMessag es; | |
2099 | end | |
2100 | else | |
2101 | begin | |
2102 | //Kil l the old Dx list | |
2103 | for i := 0 to p red(UBAGlo bals.tempD xList.Coun t) do | |
2104 | TO bject(UBAG lobals.tem pDxList[i] ).Free; | |
2105 | ||
2106 | UBAGl obals.temp DxList.Cle ar; | |
2107 | Appli cation.Pro cessMessag es; | |
2108 | ||
2109 | //Cre ate new Dx list for newly sele cted patie nt | |
2110 | if n ot Assigne d(UBAGloba ls.tempDxL ist) then | |
2111 | b egin | |
2112 | U BAGlobals. tempDxList := TList. Create; | |
2113 | U BAGlobals. tempDxList .Count := 0; | |
2114 | A pplication .ProcessMe ssages; | |
2115 | e nd; | |
2116 | end; | |
2117 | end; | |
2118 | ||
2119 | procedure TfrmFrame. mnuFileOpe nClick(Sen der: TObje ct); | |
2120 | { select a new patie nt & updat e the head er display s (patient id, encou nter, post ings) } | |
2121 | var | |
2122 | SaveDFN, Reason: s tring; | |
2123 | ok, OldR emindersSt arted, PtS elCancelle d: Boolean ; | |
2124 | CCOWResp onse: User Response; | |
2125 | ThisSess ionChanges : TChanges ; | |
2126 | i: Integ er; | |
2127 | begin | |
2128 | pnlPatie nt.Enabled := FALSE; | |
2129 | if (Send er = mnuFi leOpen) or (FRefresh ing) then | |
2130 | PTSwit chRefresh := True | |
2131 | else | |
2132 | PTSwit chRefresh := FALSE; // part of a change to CQ #115 29 | |
2133 | PtSelCan celled := FALSE; | |
2134 | if not F Refreshing then | |
2135 | mnuFil e.Tag := 0 | |
2136 | else | |
2137 | mnuFil e.Tag := 1 ; | |
2138 | Determin eNextTab; | |
2139 | // if Se nder <> mn uFileNext then //CQ 162 73 & 16419 - Missing Review/Si gn Changes dialog wh en clickin g 'Next' b utton. | |
2140 | ThisSess ionChanges := TChang es.Create; | |
2141 | try | |
2142 | // Loo p through and add in the docum ents | |
2143 | for i := 0 to Ch anges.Docu ments.Coun t - 1 do | |
2144 | begi n | |
2145 | Th isSessionC hanges.Add (CH_DOC, | |
2146 | TChangeIte m(Changes. Documents. Items[i]). ID, | |
2147 | TChangeIte m(Changes. Documents. Items[i]). Text, | |
2148 | TChangeIte m(Changes. Documents. Items[i]). GroupName, | |
2149 | TChangeIte m(Changes. Documents. Items[i]). SignState, | |
2150 | TChangeIte m(Changes. Documents. Items[i]). ParentID, | |
2151 | TChangeIte m(Changes. Documents. Items[i]). User, | |
2152 | TChangeIte m(Changes. Documents. Items[i]). OrderDG, | |
2153 | TChangeIte m(Changes. Documents. Items[i]). DCOrder, | |
2154 | TChangeIte m(Changes. Documents. Items[i]). Delay); | |
2155 | end; | |
2156 | // Loo p through and add in the order s | |
2157 | for i := 0 to Ch anges.Orde rs.Count - 1 do | |
2158 | begi n | |
2159 | Th isSessionC hanges.Add (CH_ORD, | |
2160 | TChangeIte m(Changes. Orders.Ite ms[i]).ID, | |
2161 | TChangeIte m(Changes. Orders.Ite ms[i]).Tex t, | |
2162 | TChangeIte m(Changes. Orders.Ite ms[i]).Gro upName, | |
2163 | TChangeIte m(Changes. Orders.Ite ms[i]).Sig nState, | |
2164 | TChangeIte m(Changes. Orders.Ite ms[i]).Par entID, | |
2165 | TChangeIte m(Changes. Orders.Ite ms[i]).Use r, | |
2166 | TChangeIte m(Changes. Orders.Ite ms[i]).Ord erDG, | |
2167 | TChangeIte m(Changes. Orders.Ite ms[i]).DCO rder, | |
2168 | TChangeIte m(Changes. Orders.Ite ms[i]).Del ay); | |
2169 | end; | |
2170 | // Loo p through and add in PCE | |
2171 | for i := 0 to Ch anges.PCE. Count - 1 do | |
2172 | begi n | |
2173 | Th isSessionC hanges.Add (CH_PCE, | |
2174 | TChangeIte m(Changes. PCE.Items[ i]).ID, | |
2175 | TChangeIte m(Changes. PCE.Items[ i]).Text, | |
2176 | TChangeIte m(Changes. PCE.Items[ i]).GroupN ame, | |
2177 | TChangeIte m(Changes. PCE.Items[ i]).SignSt ate, | |
2178 | TChangeIte m(Changes. PCE.Items[ i]).Parent ID, | |
2179 | TChangeIte m(Changes. PCE.Items[ i]).User, | |
2180 | TChangeIte m(Changes. PCE.Items[ i]).OrderD G, | |
2181 | TChangeIte m(Changes. PCE.Items[ i]).DCOrde r, | |
2182 | TChangeIte m(Changes. PCE.Items[ i]).Delay) ; | |
2183 | end; | |
2184 | if not AllowCont extChangeA ll(Reason) then | |
2185 | begi n | |
2186 | pn lPatient.E nabled := True; | |
2187 | // If this i s cancelle d then rel oad this s essions ch anges. | |
2188 | Ch anges.Clea r; | |
2189 | // Loop thro ugh and ad d in the d ocuments | |
2190 | fo r i := 0 t o ThisSess ionChanges .Documents .Count - 1 do | |
2191 | begin | |
2192 | Changes. Add(CH_DOC , | |
2193 | TChang eItem(This SessionCha nges.Docum ents.Items [i]).ID, | |
2194 | TChang eItem(This SessionCha nges.Docum ents.Items [i]).Text, | |
2195 | TChang eItem(This SessionCha nges.Docum ents.Items [i]).Group Name, | |
2196 | TChang eItem(This SessionCha nges.Docum ents.Items [i]).SignS tate, | |
2197 | TChang eItem(This SessionCha nges.Docum ents.Items [i]).Paren tID, | |
2198 | TChang eItem(This SessionCha nges.Docum ents.Items [i]).User, | |
2199 | TChang eItem(This SessionCha nges.Docum ents.Items [i]).Order DG, | |
2200 | TChang eItem(This SessionCha nges.Docum ents.Items [i]).DCOrd er, | |
2201 | TChang eItem(This SessionCha nges.Docum ents.Items [i]).Delay ); | |
2202 | end; | |
2203 | // Loop thro ugh and ad d in the o rders | |
2204 | fo r i := 0 t o ThisSess ionChanges .Orders.Co unt - 1 do | |
2205 | begin | |
2206 | Changes. Add(CH_ORD , TChangeI tem(ThisSe ssionChang es.Orders. Items[i]). ID, | |
2207 | TChang eItem(This SessionCha nges.Order s.Items[i] ).Text, | |
2208 | TChang eItem(This SessionCha nges.Order s.Items[i] ).GroupNam e, | |
2209 | TChang eItem(This SessionCha nges.Order s.Items[i] ).SignStat e, | |
2210 | TChang eItem(This SessionCha nges.Order s.Items[i] ).ParentID , | |
2211 | TChang eItem(This SessionCha nges.Order s.Items[i] ).User, | |
2212 | TChang eItem(This SessionCha nges.Order s.Items[i] ).OrderDG, | |
2213 | TChang eItem(This SessionCha nges.Order s.Items[i] ).DCOrder, | |
2214 | TChang eItem(This SessionCha nges.Order s.Items[i] ).Delay); | |
2215 | end; | |
2216 | // Loop thro ugh and ad d in PCE | |
2217 | fo r i := 0 t o ThisSess ionChanges .PCE.Count - 1 do | |
2218 | begin | |
2219 | Changes. Add(CH_PCE , TChangeI tem(ThisSe ssionChang es.PCE.Ite ms[i]).ID, | |
2220 | TChang eItem(This SessionCha nges.PCE.I tems[i]).T ext, | |
2221 | TChang eItem(This SessionCha nges.PCE.I tems[i]).G roupName, | |
2222 | TChang eItem(This SessionCha nges.PCE.I tems[i]).S ignState, | |
2223 | TChang eItem(This SessionCha nges.PCE.I tems[i]).P arentID, | |
2224 | TChang eItem(This SessionCha nges.PCE.I tems[i]).U ser, | |
2225 | TChang eItem(This SessionCha nges.PCE.I tems[i]).O rderDG, | |
2226 | TChang eItem(This SessionCha nges.PCE.I tems[i]).D COrder, | |
2227 | TChang eItem(This SessionCha nges.PCE.I tems[i]).D elay); | |
2228 | end; | |
2229 | ex it; | |
2230 | end; | |
2231 | finally | |
2232 | ThisSe ssionChang es.Clear; | |
2233 | ThisSe ssionChang es.Free; | |
2234 | end; | |
2235 | // updat e status t ext here | |
2236 | stsArea. Panels.Ite ms[1].Text := ''; | |
2237 | if (not User.IsRep ortsOnly) then | |
2238 | begin | |
2239 | if n ot FRefres hing then | |
2240 | be gin | |
2241 | Notificati ons.Next; // avoid p rompt if n o more ale rts select ed to proc ess {v14a RV} | |
2242 | if Notific ations.Act ive then | |
2243 | begin | |
2244 | if (in foBox(TX_N OTIF_STOP, TC_NOTIF_ STOP, MB_Y ESNO) = ID _NO) then | |
2245 | begi n | |
2246 | No tification s.Prior; | |
2247 | pn lPatient.E nabled := True; | |
2248 | ex it; | |
2249 | end; | |
2250 | end; | |
2251 | if Notific ations.Act ive then | |
2252 | Notifica tions.Prio r; | |
2253 | en d; | |
2254 | end; | |
2255 | ||
2256 | if FNoPa tientSelec ted then | |
2257 | SaveDF N := '' | |
2258 | else | |
2259 | SaveDF N := Patie nt.DFN; | |
2260 | ||
2261 | OldRemin dersStarte d := Remin dersStarte d; | |
2262 | Reminder sStarted : = FALSE; | |
2263 | try | |
2264 | if FRe freshing t hen | |
2265 | begi n | |
2266 | Up datePtInfo OnRefresh; | |
2267 | ok := True; | |
2268 | end | |
2269 | else | |
2270 | begi n | |
2271 | ok := FALSE; | |
2272 | if (not User .IsReports Only) then | |
2273 | begin | |
2274 | if FCCOW Installed and (ctxCo ntextor.St ate = csPa rticipatin g) then | |
2275 | begin | |
2276 | Upda teCCOWCont ext; | |
2277 | if n ot FCCOWEr ror then | |
2278 | be gin | |
2279 | FCCOWIconN ame := 'BM P_CCOW_LIN KED'; | |
2280 | pnlCCOW.Hi nt := TX_C COW_LINKED ; | |
2281 | imgCCOW.Pi cture.Bitm ap.LoadFro mResourceN ame(hInsta nce, FCCOW IconName); | |
2282 | en d; | |
2283 | end | |
2284 | else | |
2285 | begin | |
2286 | FCCO WIconName := 'BMP_CC OW_BROKEN' ; | |
2287 | pnlC COW.Hint : = TX_CCOW_ BROKEN; | |
2288 | imgC COW.Pictur e.Bitmap.L oadFromRes ourceName( hInstance, FCCOWIcon Name); | |
2289 | end; | |
2290 | if (Pati ent.DFN = '') or (Se nder = mnu FileOpen) or (Sender = mnuFile Next) or ( Sender = m nuViewDemo ) then | |
2291 | Select Patient(SH OW_NOTIFIC ATIONS, Fo nt.Size, P tSelCancel led); | |
2292 | if PtSel Cancelled then | |
2293 | begin | |
2294 | pnlP atient.Ena bled := Tr ue; | |
2295 | exit ; | |
2296 | end; | |
2297 | ShowEver ything; | |
2298 | // HideE verything( 'Retrievin g informat ion - plea se wait... .'); //v2 7 (pending ) RV | |
2299 | DisplayE ncounterTe xt; | |
2300 | FPrevInP atient := Patient.In patient; | |
2301 | if Notif ications.A ctive then | |
2302 | begin | |
2303 | // d isplay 'ne xt notific ation' but ton | |
2304 | SetU pNextButto n; | |
2305 | FNex tButtonAct ive := Tru e; | |
2306 | mnuF ileNext.En abled := T rue; | |
2307 | mnuF ileNextCli ck(mnuFile Open); | |
2308 | end | |
2309 | else | |
2310 | begin | |
2311 | // h ide the 'n ext notifi cation' bu tton | |
2312 | FNex tButtonAct ive := FAL SE; | |
2313 | FNex tButton.Fr ee; | |
2314 | FNex tButton := nil; | |
2315 | mnuF ileNext.En abled := F ALSE; | |
2316 | mnuF ileNotifRe move.Enabl ed := FALS E; | |
2317 | //if Patient.D FN <> Save DFN then | |
2318 | // r emoved, to o many thi ngs happen ing, just refresh th e patient. | |
2319 | ok : = True; | |
2320 | end | |
2321 | end | |
2322 | el se | |
2323 | begin | |
2324 | Notifica tions.Clea r; | |
2325 | SelectPa tient(FALS E, Font.Si ze, PtSelC ancelled); // Call P t. Sel. w/ o notifica tions. | |
2326 | if PtSel Cancelled then | |
2327 | exit; | |
2328 | ShowEver ything; | |
2329 | DisplayE ncounterTe xt; | |
2330 | FPrevInP atient := Patient.In patient; | |
2331 | ok := Tr ue; | |
2332 | end; | |
2333 | end; | |
2334 | if ok then | |
2335 | begi n | |
2336 | if FCCOWInst alled and (ctxContex tor.State = csPartic ipating) a nd (not FR efreshing) and (not FCCOWJustJ oined) the n | |
2337 | begin | |
2338 | if (Allo wCCOWConte xtChange(C COWRespons e, Patient .DFN)) the n | |
2339 | begin | |
2340 | Setu pPatient; | |
2341 | tabP age.TabInd ex := Page IDToTab(Ne xtTab); | |
2342 | tabP ageChange( tabPage); | |
2343 | end | |
2344 | else | |
2345 | begin | |
2346 | case CCOWRespo nse of | |
2347 | ur Cancel: | |
2348 | UpdateCCOW Context; | |
2349 | ur Break: | |
2350 | begin | |
2351 | // do no t revert t o old DFN if context was manua lly broken by user - v26 (RV) | |
2352 | if (ctxC ontextor.S tate = csP articipati ng) then | |
2353 | Patien t.DFN := S aveDFN; | |
2354 | SetupPat ient; | |
2355 | tabPage. TabIndex : = PageIDTo Tab(NextTa b); | |
2356 | tabPageC hange(tabP age); | |
2357 | end; | |
2358 | else | |
2359 | be gin | |
2360 | SetupPatie nt; | |
2361 | tabPage.Ta bIndex := PageIDToTa b(NextTab) ; | |
2362 | tabPageCha nge(tabPag e); | |
2363 | en d; | |
2364 | end; | |
2365 | end; | |
2366 | end | |
2367 | el se | |
2368 | begin | |
2369 | SetupPat ient; | |
2370 | tabPage. TabIndex : = PageIDTo Tab(NextTa b); | |
2371 | tabPageC hange(tabP age); | |
2372 | FCCOWJus tJoined := FALSE; | |
2373 | end; | |
2374 | end; | |
2375 | finally | |
2376 | if (no t FRefresh ing) and ( Patient.DF N = SaveDF N) then | |
2377 | Remi ndersStart ed := OldR emindersSt arted; | |
2378 | FFirst Load := FA LSE; | |
2379 | end; | |
2380 | { Begin BillingAwa re } | |
2381 | if BILLI NG_AWARE t hen | |
2382 | frmFra me.SetBADx List; // e nd IsBilli ngAware | |
2383 | { End Bi llingAware } | |
2384 | if not F Refreshing then | |
2385 | begin | |
2386 | DoNo tChangeEnc Window := FALSE; | |
2387 | Orde rPrintForm := FALSE; | |
2388 | uCor e.TempEnco unterLoc : = 0; | |
2389 | uCor e.TempEnco unterLocNa me := ''; | |
2390 | end; | |
2391 | pnlPatie nt.Enabled := True; | |
2392 | // PaPI ---------- ---------- ---------- ---------- ---------- ---------- ---------- -- | |
2393 | frmMeds. PaPI_GUIse tup(papiPa rkingAvail able(Encou nter)); | |
2394 | end; | |
2395 | ||
2396 | procedure TfrmFrame. DetermineN extTab; | |
2397 | begin | |
2398 | if (FRef reshing or User.UseL astTab) an d (not FFi rstLoad) t hen | |
2399 | begin | |
2400 | if ( tabPage.Ta bIndex < 0 ) then | |
2401 | Ne xtTab := L astTab | |
2402 | else | |
2403 | Ne xtTab := T abToPageID (tabPage.T abIndex); | |
2404 | end | |
2405 | else | |
2406 | NextTa b := User. InitialTab ; | |
2407 | if NextT ab = CT_NO PAGE then | |
2408 | NextTa b := User. InitialTab ; | |
2409 | if User. IsReportsO nly then / / Reports Only tab. | |
2410 | NextTa b := CT_RE PORTS; // Only one t ab should exist by t his point in "REPORT S ONLY" mo de. | |
2411 | if not T abExists(N extTab) th en | |
2412 | NextTa b := CT_CO VER; | |
2413 | if NextT ab = CT_NO PAGE then | |
2414 | NextTa b := User. InitialTab ; | |
2415 | if NextT ab = CT_OR DERS then | |
2416 | if frm Orders <> nil then | |
2417 | with frmOrders do | |
2418 | be gin | |
2419 | if (lstShe ets.ItemIn dex > -1) and (TheCu rrentView <> nil) an d (TheCurr entView.Ev entDelay.P tEventIFN > 0) then | |
2420 | PtEvtCom pleted(The CurrentVie w.EventDel ay.PtEvent IFN, TheCu rrentView. EventDelay .EventName ); | |
2421 | en d; | |
2422 | end; | |
2423 | ||
2424 | procedure TfrmFrame. mnuFileEnc ounterClic k(Sender: TObject); | |
2425 | { displays encounter window an d updates encounter display in case enco unter was updated } | |
2426 | begin | |
2427 | UpdateEn counter(NP F_ALL); {* KCM*} | |
2428 | DisplayE ncounterTe xt; | |
2429 | end; | |
2430 | ||
2431 | procedure TfrmFrame. mnuFileRev iewClick(S ender: TOb ject); | |
2432 | { displays the Revie w Changes window (wh ich resets the Encou nter objec t) } | |
2433 | var | |
2434 | EventCha nges: bool ean; | |
2435 | NameNeed Look: stri ng; | |
2436 | begin | |
2437 | FReviewC lick := Tr ue; | |
2438 | mnuFile. Tag := 1; | |
2439 | EventCha nges := Fa lse; | |
2440 | NameNeed Look := '' ; | |
2441 | //Update PtInfoOnRe fresh; | |
2442 | if Chang es.Count > 0 then | |
2443 | begin | |
2444 | if (frm Orders <> nil) and ( frmOrders. TheCurrent View <> ni l) and ( f rmOrders.T heCurrentV iew.EventD elay.Event IFN>0) the n | |
2445 | begin | |
2446 | Event Changes := True; | |
2447 | NameN eedLook := frmOrders .TheCurren tView.View Name; | |
2448 | frmOr ders.PtEvt Completed( frmOrders. TheCurrent View.Event Delay.PtEv entIFN, fr mOrders.Th eCurrentVi ew.EventDe lay.EventN ame); | |
2449 | end; | |
2450 | ReviewC hanges(Tim edOut, Eve ntChanges) ; | |
2451 | if TabT oPageID(ta bPage.TabI ndex)= CT_ MEDS then | |
2452 | begin | |
2453 | frmOr ders.InitO rderSheets 2(NameNeed Look); | |
2454 | end; | |
2455 | end | |
2456 | else Inf oBox('No n ew changes to review /sign.', ' Review Cha nges', MB_ OK); | |
2457 | //CQ #17 491: Moved UpdatePtI nfoOnRefre sh here to allow for the updat ing of the patient s tatus indi cator | |
2458 | //in the header ba r (after t he Review Changes di alog close s) if the patient be comes admi tted/disch arged. | |
2459 | UpdatePt InfoOnRefr esh; | |
2460 | FOrderPr intForm := false; | |
2461 | FReviewC lick := fa lse; | |
2462 | end; | |
2463 | ||
2464 | procedure TfrmFrame. mnuFileExi tClick(Sen der: TObje ct); | |
2465 | { see the CloseQuery event } | |
2466 | var | |
2467 | i: small int; | |
2468 | begin | |
2469 | try | |
2470 | if B ILLING_AWA RE then | |
2471 | b egin | |
2472 | i f Assigned (tempDxLis t) then | |
2473 | for i := 0 to pred (UBAGlobal s.tempDxLi st.Count) do | |
2474 | TObje ct(UBAGlob als.tempDx List[i]).F ree; | |
2475 | ||
2476 | U BAGlobals. tempDxList .Clear; | |
2477 | A pplication .ProcessMe ssages; | |
2478 | e nd; //end IsBillingA ware | |
2479 | except | |
2480 | on EA ccessViola tion do | |
2481 | be gin | |
2482 | {$ ifdef debu g}Show508M essage('Ac cess Viola tion in pr ocedure Tf rmFrame.mn uFileExitC lick()');{ $endif} | |
2483 | ra ise; | |
2484 | en d; | |
2485 | on E: Exception do | |
2486 | be gin | |
2487 | {$ ifdef debu g}Show508M essage('Un handled ex ception in procedure TfrmFrame .mnuFileEx itClick()' );{$endif} | |
2488 | ra ise; | |
2489 | en d; | |
2490 | end; | |
2491 | ||
2492 | Close; | |
2493 | end; | |
2494 | ||
2495 | { View Men u Events - ---------- ---------- ---------- ---------- ---------- ---------- ---------- -- } | |
2496 | ||
2497 | procedure TfrmFrame. mnuViewPos tingsClick (Sender: T Object); | |
2498 | begin | |
2499 | end; | |
2500 | ||
2501 | { Tool Men u Events - ---------- ---------- ---------- ---------- ---------- ---------- ---------- -- } | |
2502 | ||
2503 | function T frmFrame.E xpandComma nd(x: stri ng): strin g; | |
2504 | { look for 'macros' on the com mand line and expand them usin g current context } | |
2505 | ||
2506 | procedur e Substitu te(const K ey, Data: string); | |
2507 | var | |
2508 | Stop, Start: Int eger; | |
2509 | begin | |
2510 | Stop := Pos(Key , x) - 1; | |
2511 | Start := Stop + Length(Key ) + 1; | |
2512 | x := C opy(x, 1, Stop) + Da ta + Copy( x, Start, Length(x)) ; | |
2513 | end; | |
2514 | ||
2515 | begin | |
2516 | if Pos(' %MREF', x) > 0 then Substitute ('%MREF', | |
2517 | '^TMP( ''ORWCHART '',' + Use r.JobNumbe r + ',''' + DottedIP Str + ''', ' + IntToH ex(Handle, 8) + ')') ; | |
2518 | if Pos(' %SRV', x) > 0 then Substitute ('%SRV', String(RPC BrokerV.Se rver)); | |
2519 | if Pos(' %PORT', x) > 0 then Substitute ('%PORT', IntToStr(R PCBrokerV. ListenerPo rt)); | |
2520 | if Pos(' %DFN', x) > 0 then Substitute ('%DFN', Patient.DF N); //*DF N* | |
2521 | if Pos(' %DUZ', x) > 0 then Substitute ('%DUZ', IntToStr(U ser.DUZ)); | |
2522 | if Pos(' %H', x) > 0 then Su bstitute(' %H', Strin g(RPCBroke rV.LogIn.L ogInHandle )); | |
2523 | Result : = x; | |
2524 | end; | |
2525 | ||
2526 | procedure TfrmFrame. ToolClick( Sender: TO bject); | |
2527 | { executes the progr am associa ted with a n item on the Tools menu, the command li ne is stor ed | |
2528 | in the i tem's hint property } | |
2529 | const | |
2530 | TXT_ECS_ NOTFOUND = 'The ECS applicatio n is not f ound at th e default directory, ' + #13 + 'would you like manu ally searc h it?'; | |
2531 | TC_ECS_N OTFOUND = 'Applicati on Not Fou nd'; | |
2532 | var | |
2533 | x, AFile , Param, M enuCommand , ECSAppen d, CapNm, curPath : string; | |
2534 | IsECSInt erface: bo olean; | |
2535 | ||
2536 | function TakeOutAm ps(AString : string): string; | |
2537 | var | |
2538 | S1,S2: string; | |
2539 | begin | |
2540 | if Pos ('&',AStri ng)=0 then | |
2541 | begin | |
2542 | Resu lt := AStr ing; | |
2543 | Exit ; | |
2544 | end; | |
2545 | S1 := Piece(AStr ing,'&',1) ; | |
2546 | S2 := Piece(AStr ing,'&',2) ; | |
2547 | Result := S1 + S 2; | |
2548 | end; | |
2549 | ||
2550 | function ExcuteEC( AFile,APar a: string) : boolean; | |
2551 | begin | |
2552 | if (Sh ellExecute (Handle, ' open', PCh ar(AFile), PChar(Par am), '', S W_NORMAL) > 32 ) the n Result : = True | |
2553 | else | |
2554 | begin | |
2555 | if I nfoBox(TXT _ECS_NOTFO UND, TC_EC S_NOTFOUND , MB_YESNO or MB_ICO NERROR) = IDYES then | |
2556 | begi n | |
2557 | if OROpenDlg .Execute t hen | |
2558 | be gin | |
2559 | AFile := OROpenDlg. FileName; | |
2560 | if Pos('e cs gui.exe ',lowerCas e(AFile))< 1 then | |
2561 | begin | |
2562 | ShowMsg ('This is not a vali d ECS appl ication.') ; | |
2563 | Result := True; | |
2564 | end else | |
2565 | begin | |
2566 | if (She llExecute( Handle, 'o pen', PCha r(AFile), PChar(Para m), '', SW _NORMAL)<3 2) then Re sult := Fa lse | |
2567 | else Re sult := Tr ue; | |
2568 | end; | |
2569 | en d | |
2570 | el se Result := True; | |
2571 | end else Resul t := True; | |
2572 | end; | |
2573 | end; | |
2574 | ||
2575 | function ExcuteECS (AFile, AP ara: strin g; var cur rPath: str ing): bool ean; | |
2576 | var | |
2577 | comman dline,RPCH andle: str ing; | |
2578 | Startu pInfo: TSt artupInfo; | |
2579 | Proces sInfo: TPr ocessInfor mation; | |
2580 | begin | |
2581 | FillCh ar(Startup Info, Size Of(TStartu pInfo), 0) ; | |
2582 | with S tartupInfo do | |
2583 | begin | |
2584 | cb : = SizeOf(T StartupInf o); | |
2585 | dwFl ags := STA RTF_USESHO WWINDOW; | |
2586 | wSho wWindow := SW_SHOWNO RMAL; | |
2587 | end; | |
2588 | comman dline := A File + Par am; | |
2589 | RPCHan dle := Get AppHandle( RPCBrokerV ); | |
2590 | comman dline := c ommandline + ' H=' + RPCHandle ; | |
2591 | if Cre ateProcess (nil, PCha r(commandl ine), nil, nil, Fals e, | |
2592 | NORM AL_PRIORIT Y_CLASS, n il, nil, S tartupInfo , ProcessI nfo) then Result := True | |
2593 | else | |
2594 | begin | |
2595 | if I nfoBox(TXT _ECS_NOTFO UND, TC_EC S_NOTFOUND , MB_YESNO or MB_ICO NERROR) = IDYES then | |
2596 | begi n | |
2597 | if OROpenDlg .Execute t hen | |
2598 | be gin | |
2599 | AFile := OROpenDlg. FileName; | |
2600 | if Pos('e cs gui.exe ',lowerCas e(AFile))< 1 then | |
2601 | begin | |
2602 | ShowMsg ('This is not a vali d ECS appl ication.') ; | |
2603 | Result := True; | |
2604 | end else | |
2605 | begin | |
2606 | SaveUse rPath('Eve nt Capture Interface ='+AFile, currPath); | |
2607 | FillCha r(StartupI nfo, SizeO f(TStartup Info), 0); | |
2608 | with St artupInfo do | |
2609 | begin | |
2610 | cb := SizeOf(TS tartupInfo ); | |
2611 | dwFla gs := STAR TF_USESHOW WINDOW; | |
2612 | wShow Window := SW_SHOWNOR MAL; | |
2613 | end; | |
2614 | command line := AF ile + Para m; | |
2615 | RPCHand le := GetA ppHandle(R PCBrokerV) ; | |
2616 | command line := co mmandline + ' H=' + RPCHandle; | |
2617 | if not CreateProc ess(nil, P Char(comma ndline), n il, nil, F alse, | |
2618 | NORM AL_PRIORIT Y_CLASS, n il, nil,St artupInfo, ProcessInf o) then Re sult := Fa lse | |
2619 | else Re sult := Tr ue; | |
2620 | end; | |
2621 | en d | |
2622 | el se Result := True; | |
2623 | end else Resul t := True; | |
2624 | end; | |
2625 | end; | |
2626 | ||
2627 | begin | |
2628 | MenuComm and := ''; | |
2629 | ECSAppen d := ''; | |
2630 | IsECSInt erface := False; | |
2631 | curPath := ''; | |
2632 | CapNm := LowerCase (TMenuItem (Sender).C aption); | |
2633 | CapNm := TakeOutAm ps(CapNm); | |
2634 | if AnsiC ompareText ('event ca pture inte rface',Cap Nm)=0 then | |
2635 | begin | |
2636 | IsECSI nterface : = True; | |
2637 | if FEC SAuthUser then Updat eECSParame ter(ECSApp end) | |
2638 | else b egin | |
2639 | Show Msg('You d on''t have permissio n to use E CS.'); | |
2640 | exit ; | |
2641 | end; | |
2642 | end; | |
2643 | MenuComm and := TMe nuItem(Sen der).Hint + ECSAppen d; | |
2644 | x := Exp andCommand (MenuComma nd); | |
2645 | if CharA t(x, 1) = '"' then | |
2646 | begin | |
2647 | x := Copy(x, 2, Length (x)); | |
2648 | AFile := Copy(x, 1, Pos('" ',x)-1); | |
2649 | Param := Copy(x, Pos('"',x )+1, Lengt h(x)); | |
2650 | end else | |
2651 | begin | |
2652 | AFile := Piece(x , ' ', 1); | |
2653 | Param := Copy(x, Length(AF ile)+1, Le ngth(x)); | |
2654 | end; | |
2655 | if IsECS Interface then | |
2656 | begin | |
2657 | if not ExcuteECS (AFile,Par am,curPath ) then | |
2658 | Excu teECS(AFil e,Param,cu rPath); | |
2659 | if Len gth(curPat h)>0 then | |
2660 | TMen uItem(Send er).Hint : = curPath; | |
2661 | end | |
2662 | else if (Pos('ecs' ,LowerCase (AFile))>0 ) and (not IsECSInte rface) the n | |
2663 | begin | |
2664 | if not ExcuteEC( AFile,Para m) then | |
2665 | Excu teEC(AFile ,Param); | |
2666 | end else | |
2667 | begin | |
2668 | ShellE xecute(Han dle, 'open ', PChar(A File), PCh ar(Param), '', SW_NO RMAL); | |
2669 | end; | |
2670 | end; | |
2671 | ||
2672 | { Help Men u Events - ---------- ---------- ---------- ---------- ---------- ---------- ---------- -- } | |
2673 | ||
2674 | procedure TfrmFrame. mnuHelpBro kerClick(S ender: TOb ject); | |
2675 | { used for debugging - shows l ast n brok er calls } | |
2676 | begin | |
2677 | ShowBrok er; | |
2678 | end; | |
2679 | ||
2680 | procedure TfrmFrame. mnuHelpLis tsClick(Se nder: TObj ect); | |
2681 | { used for debugging - shows i nternal co ntents of TORListBox } | |
2682 | begin | |
2683 | if Scree n.ActiveCo ntrol is T ListBox | |
2684 | then D ebugListIt ems(TListB ox(Screen. ActiveCont rol)) | |
2685 | else I nfoBox('Fo cus contro l is not a listbox', 'ListBox Data', MB_ OK); | |
2686 | end; | |
2687 | ||
2688 | procedure TfrmFrame. mnuHelpSym bolsClick( Sender: TO bject); | |
2689 | { used for debugging - shows c urrent sym bol table } | |
2690 | begin | |
2691 | DebugSho wServer; | |
2692 | end; | |
2693 | ||
2694 | procedure TfrmFrame. mnuHelpAbo utClick(Se nder: TObj ect); | |
2695 | { displays the about screen } | |
2696 | begin | |
2697 | ShowAbou t; | |
2698 | end; | |
2699 | ||
2700 | { Status B ar Methods } | |
2701 | ||
2702 | procedure TfrmFrame. UMStatusTe xt(var Mes sage: TMes sage); | |
2703 | { displays status ba r text (us ing the po inter to a text buff er passed in LParam) } | |
2704 | begin | |
2705 | stsArea. Panels.Ite ms[0].Text := StrPas (PChar(Mes sage.LPara m)); | |
2706 | stsArea. Refresh; | |
2707 | end; | |
2708 | ||
2709 | { Toolbar Methods (m ake panels act like buttons) - ---------- ---------- ---------- ---------- -- } | |
2710 | ||
2711 | procedure TfrmFrame. pnlPatient MouseDown( Sender: TO bject; But ton: TMous eButton; | |
2712 | Shift: T ShiftState ; X, Y: In teger); | |
2713 | { emulate a button p ress in th e patient identifica tion panel } | |
2714 | begin | |
2715 | if pnlPa tient.Beve lOuter = b vLowered t hen exit; | |
2716 | pnlPatie nt.BevelOu ter := bvL owered; | |
2717 | with lbl PtName do SetBounds( Left+2, To p+2, Width , Height); | |
2718 | with lbl PtSSN do SetBounds( Left+2, To p+2, Width , Height); | |
2719 | with lbl PtAge do SetBounds( Left+2, To p+2, Width , Height); | |
2720 | end; | |
2721 | ||
2722 | procedure TfrmFrame. pnlPatient MouseUp(Se nder: TObj ect; Butto n: TMouseB utton; | |
2723 | Shift: T ShiftState ; X, Y: In teger); | |
2724 | { emulate the button raising i n the pati ent identi fication p anel & cal l Patient Inquiry } | |
2725 | begin | |
2726 | if pnlPa tient.Beve lOuter = b vRaised th en exit; | |
2727 | pnlPatie nt.BevelOu ter := bvR aised; | |
2728 | with lbl PtName do SetBounds( Left-2, To p-2, Width , Height); | |
2729 | with lbl PtSSN do SetBounds( Left-2, To p-2, Width , Height); | |
2730 | with lbl PtAge do SetBounds( Left-2, To p-2, Width , Height); | |
2731 | end; | |
2732 | ||
2733 | procedure TfrmFrame. pnlVisitMo useDown(Se nder: TObj ect; Butto n: TMouseB utton; | |
2734 | Shift: T ShiftState ; X, Y: In teger); | |
2735 | { emulate a button p ress in th e encounte r panel } | |
2736 | begin | |
2737 | if User. IsReportsO nly then | |
2738 | exit; | |
2739 | if pnlVi sit.BevelO uter = bvL owered the n exit; | |
2740 | pnlVisit .BevelOute r := bvLow ered; | |
2741 | with lbl PtLocation do SetBou nds(Left+2 , Top+2, W idth, Heig ht); | |
2742 | with lbl PtProvider do SetBou nds(Left+2 , Top+2, W idth, Heig ht); | |
2743 | end; | |
2744 | ||
2745 | procedure TfrmFrame. pnlVisitMo useUp(Send er: TObjec t; Button: TMouseBut ton; | |
2746 | Shift: T ShiftState ; X, Y: In teger); | |
2747 | { emulate a button r aising in the encoun ter panel and call U pdate Prov ider/Locat ion } | |
2748 | begin | |
2749 | if User. IsReportsO nly then | |
2750 | exit; | |
2751 | if pnlVi sit.BevelO uter = bvR aised then exit; | |
2752 | pnlVisit .BevelOute r := bvRai sed; | |
2753 | with lbl PtLocation do SetBou nds(Left-2 , Top-2, W idth, Heig ht); | |
2754 | with lbl PtProvider do SetBou nds(Left-2 , Top-2, W idth, Heig ht); | |
2755 | end; | |
2756 | ||
2757 | procedure TfrmFrame. pnlVistaWe bClick(Sen der: TObje ct); | |
2758 | begin | |
2759 | inherite d; | |
2760 | uUseVist aWeb := tr ue; | |
2761 | pnlVista Web.BevelO uter := bv Lowered; | |
2762 | pnlCIRNC lick(self) ; | |
2763 | uUseVist aWeb := fa lse; | |
2764 | end; | |
2765 | ||
2766 | procedure TfrmFrame. pnlVistaWe bMouseDown (Sender: T Object; Bu tton: TMou seButton; | |
2767 | Shift: T ShiftState ; X, Y: In teger); | |
2768 | begin | |
2769 | inherite d; | |
2770 | pnlVista Web.BevelO uter := bv Lowered; | |
2771 | end; | |
2772 | ||
2773 | procedure TfrmFrame. pnlVistaWe bMouseUp(S ender: TOb ject; Butt on: TMouse Button; | |
2774 | Shift: T ShiftState ; X, Y: In teger); | |
2775 | begin | |
2776 | inherite d; | |
2777 | pnlVista Web.BevelO uter := bv Raised; | |
2778 | end; | |
2779 | ||
2780 | procedure TfrmFrame. pnlPrimary CareMouseD own(Sender : TObject; | |
2781 | Button: TMouseButt on; Shift: TShiftSta te; X, Y: Integer); | |
2782 | begin | |
2783 | if pnlPr imaryCare. BevelOuter = bvLower ed then ex it; | |
2784 | pnlPrima ryCare.Bev elOuter := bvLowered ; | |
2785 | with lbl PtCare do SetBo unds(Left+ 2, Top+2, Width, Hei ght); | |
2786 | with lbl PtAttendin g do SetBo unds(Left+ 2, Top+2, Width, Hei ght); | |
2787 | with lbl PtMHTC do SetBounds( Left+2, To p+2, Width , Height); | |
2788 | end; | |
2789 | ||
2790 | procedure TfrmFrame. pnlPrimary CareMouseU p(Sender: TObject; | |
2791 | Button: TMouseButt on; Shift: TShiftSta te; X, Y: Integer); | |
2792 | begin | |
2793 | if pnlPr imaryCare. BevelOuter = bvRaise d then exi t; | |
2794 | pnlPrima ryCare.Bev elOuter := bvRaised; | |
2795 | with lbl PtCare do SetBo unds(Left- 2, Top-2, Width, Hei ght); | |
2796 | with lbl PtAttendin g do SetBo unds(Left- 2, Top-2, Width, Hei ght); | |
2797 | with lbl PtMHTC do SetBo unds(Left- 2, Top-2, Width, Hei ght); | |
2798 | end; | |
2799 | ||
2800 | procedure TfrmFrame. pnlPosting sMouseDown (Sender: T Object; | |
2801 | Button: TMouseButt on; Shift: TShiftSta te; X, Y: Integer); | |
2802 | { emulate a button p ress in th e postings panel } | |
2803 | begin | |
2804 | if pnlPo stings.Bev elOuter = bvLowered then exit; | |
2805 | pnlPosti ngs.BevelO uter := bv Lowered; | |
2806 | with lbl PtPostings do SetBou nds(Left+2 , Top+2, W idth, Heig ht); | |
2807 | with lbl PtCWAD do SetBou nds(Left+2 , Top+2, W idth, Heig ht); | |
2808 | end; | |
2809 | ||
2810 | procedure TfrmFrame. pnlPosting sMouseUp(S ender: TOb ject; | |
2811 | Button: TMouseButt on; Shift: TShiftSta te; X, Y: Integer); | |
2812 | { emulate a button r aising in the postin g panel an d call Pos tings } | |
2813 | begin | |
2814 | if pnlPo stings.Bev elOuter = bvRaised t hen exit; | |
2815 | pnlPosti ngs.BevelO uter := bv Raised; | |
2816 | with lbl PtPostings do SetBou nds(Left-2 , Top-2, W idth, Heig ht); | |
2817 | with lbl PtCWAD do SetBou nds(Left-2 , Top-2, W idth, Heig ht); | |
2818 | end; | |
2819 | ||
2820 | { Resize a nd Font-Ch ange proce dures ---- ---------- ---------- ---------- ---------- ---------- -- } | |
2821 | ||
2822 | procedure TfrmFrame. LoadSizesF orUser; | |
2823 | var | |
2824 | s1, s2, s3, s4, Du mmy: integ er; | |
2825 | panelBot tom, panel MedIn, Res toreWidth, MinCnst : integer; | |
2826 | ||
2827 | procedur e GetMinCo ntraint(aC ontrol: TW inControl; var LastM inWidth: I nteger); | |
2828 | var | |
2829 | I: inte ger; | |
2830 | begin | |
2831 | if aCon trol.Const raints.Min Width > La stMinWidth then | |
2832 | LastM inWidth := aControl. Constraint s.MinWidth ; | |
2833 | ||
2834 | for I : = 0 to aCo ntrol.Cont rolCount - 1 do | |
2835 | begin | |
2836 | if aC ontrol.Con trols[i] i s TWinCont rol then | |
2837 | GetM inContrain t(TWinCont rol(aContr ol.Control s[i]), Las tMinWidth) ; | |
2838 | end; | |
2839 | ||
2840 | end; | |
2841 | ||
2842 | begin | |
2843 | ChangeFo nt(UserFon tSize); | |
2844 | CoverShe et.OnSetFo ntSize(Sel f, UserFon tSize); | |
2845 | CoverShe et.OnSetSc reenReader Status(Sel f, ScreenR eaderSyste mActive); | |
2846 | SetUserB ounds(TCon trol(frmFr ame)); | |
2847 | SetUserW idths(TCon trol(frmPr oblems.pnl Left)); | |
2848 | SetUserW idths(TCon trol(frmOr ders.pnlLe ft)); | |
2849 | RestoreW idth := fr mNotes.pnl Left.Width ; | |
2850 | SetUserW idths(TCon trol(frmNo tes.pnlLef t)); | |
2851 | MinCnst := 0; | |
2852 | GetMinCo ntraint(fr mNotes.pnl Left, MinC nst); | |
2853 | if frmNo tes.pnlLef t.Width < MinCnst th en | |
2854 | frmNote s.pnlLeft. Width := R estoreWidt h; | |
2855 | ||
2856 | frmNotes .splHorz.L eft := frm Notes.pnlL eft.left + 1; | |
2857 | SetUserW idths(TCon trol(frmCo nsults.pnl Left)); | |
2858 | SetUserW idths(TCon trol(frmDC Summ.pnlLe ft)); | |
2859 | if Assig ned(frmSur gery) then SetUserWi dths(TCont rol(frmSur gery.pnlLe ft)); | |
2860 | SetUserW idths(TCon trol(frmLa bs.pnlLeft )); | |
2861 | SetUserW idths(TCon trol(frmRe ports.pnlL eft)); | |
2862 | SetUserC olumns(TCo ntrol(frmO rders.hdrO rders)); | |
2863 | SetUserC olumns(TCo ntrol(frmM eds.hdrMed sIn)); // still nee d conversi on | |
2864 | SetUserC olumns(TCo ntrol(frmM eds.hdrMed sOut)); | |
2865 | SetUserS tring('frm PtSel.lstv Alerts',En duringPtSe lColumns); | |
2866 | SetUserS tring(Spel lCheckerSe ttingName, SpellChec kerSetting s); | |
2867 | SetUserB ounds2(Tem plateEdito rSplitters , tmplEdit orSplitter Middle, | |
2868 | tmp lEditorSpl itterPrope rties, tmp lEditorSpl itterMain, tmplEdito rSplitterB oil); | |
2869 | SetUserB ounds2(Tem plateEdito rSplitters 2, tmplEdi torSplitte rNotes, Du mmy, Dummy , Dummy); | |
2870 | SetUserB ounds2(Rem inderTreeN ame, RemTr eeDlgLeft, RemTreeDl gTop, RemT reeDlgWidt h, RemTree DlgHeight) ; | |
2871 | SetUserB ounds2(Rem DlgName, R emDlgLeft, RemDlgTop , RemDlgWi dth, RemDl gHeight); | |
2872 | SetUserB ounds2(Rem DlgSplitte rs, RemDlg Spltr1, Re mDlgSpltr2 , Dummy ,D ummy); | |
2873 | SetUserB ounds2(Dra werSplitte rs,s1, s2, s3, S4); | |
2874 | frmNotes .Drawers.L astOpenSiz e := s1; | |
2875 | frmConsu lts.Drawer s.LastOpen Size := s2 ; | |
2876 | frmDCSum m.Drawers. LastOpenSi ze := s3; | |
2877 | if Assig ned(frmSur gery) then frmSurger y.Drawers. LastOpenSi ze := S4; //CQ7315 | |
2878 | ||
2879 | SetUserB ounds2(Not eSplitters ,s1, s2, s 3, s4); | |
2880 | frmNotes .LoadUserS plitterSet tings(s1, s2, s3, s4 ); | |
2881 | ||
2882 | SetUserB ounds2(Lab Splitters, s1, s2, s3 , s4); | |
2883 | frmLabs. LoadUserSe ttings(s1, s2, s3, s 4); | |
2884 | ||
2885 | with frm Meds do | |
2886 | begin | |
2887 | SetUs erBounds2( frmMeds.Na me+'Split' , panelBot tom, panel MedIn, Dum my, Dummy) ; | |
2888 | if (p anelBottom > frmMeds .Height-50 ) then pan elBottom : = frmMeds. Height-50; | |
2889 | if (p anelMedIn > panelBot tom-50) th en panelMe dIn := pan elBottom-5 0; | |
2890 | frmMe ds.gdpOut. Height := panelBotto m; | |
2891 | frmMe ds.gdpIn.H eight := p anelMedIn; | |
2892 | //Med s Tab Non- VA meds co lumns | |
2893 | SetUs erColumns( TControl(h drMedsNonV A)); //CQ7 314 | |
2894 | end; | |
2895 | ||
2896 | if Param Search('re z') = '640 ' then Set Bounds(Lef t, Top, 64 8, 488); // for tes ting | |
2897 | ||
2898 | end; | |
2899 | ||
2900 | procedure TfrmFrame. SaveSizesF orUser; | |
2901 | var | |
2902 | SizeList : TStringL ist; | |
2903 | SurgTemp Ht: intege r; | |
2904 | s1, s2, s3, s4: in teger; | |
2905 | begin | |
2906 | SaveUser FontSize(M ainFontSiz e); | |
2907 | SizeList := TStrin gList.Crea te; | |
2908 | try | |
2909 | with S izeList do | |
2910 | begin | |
2911 | Add( StrUserBou nds(frmFra me)); | |
2912 | Add( StrUserWid th(frmProb lems.pnlLe ft)); | |
2913 | Add( StrUserWid th(frmOrde rs.pnlLeft )); | |
2914 | Add( StrUserWid th(frmNote s.pnlLeft) ); | |
2915 | Add( StrUserWid th(frmCons ults.pnlLe ft)); | |
2916 | Add( StrUserWid th(frmDCSu mm.pnlLeft )); | |
2917 | if A ssigned(fr mSurgery) then Add(S trUserWidt h(frmSurge ry.pnlLeft )); | |
2918 | Add( StrUserWid th(frmLabs .pnlLeft)) ; | |
2919 | Add( StrUserWid th(frmRepo rts.pnlLef t)); | |
2920 | Add( StrUserCol umns(frmOr ders.hdrOr ders)); | |
2921 | Add( StrUserCol umns(frmMe ds.hdrMeds In)); | |
2922 | Add( StrUserCol umns(frmMe ds.hdrMeds Out)); | |
2923 | Add( StrUserStr ing(SpellC heckerSett ingName, S pellChecke rSettings) ); | |
2924 | Add( StrUserBou nds2(Templ ateEditorS plitters, tmplEditor SplitterMi ddle, | |
2925 | tmplEd itorSplitt erProperti es, tmplEd itorSplitt erMain, tm plEditorSp litterBoil )); | |
2926 | Add( StrUserBou nds2(Templ ateEditorS plitters2, tmplEdito rSplitterN otes, 0, 0 , 0)); | |
2927 | Add( StrUserBou nds2(Remin derTreeNam e, RemTree DlgLeft, R emTreeDlgT op, RemTre eDlgWidth, RemTreeDl gHeight)); | |
2928 | Add( StrUserBou nds2(RemDl gName, Rem DlgLeft, R emDlgTop, RemDlgWidt h, RemDlgH eight)); | |
2929 | Add( StrUserBou nds2(RemDl gSplitters , RemDlgSp ltr1, RemD lgSpltr2, 0 ,0)); | |
2930 | ||
2931 | //v2 6.47 - RV - access v iolation i f Surgery Tab not en abled. Se t to desig ner height as defaul t. | |
2932 | if A ssigned(fr mSurgery) then SurgT empHt := f rmSurgery. Drawers.pn lTemplates .Height el se SurgTem pHt := 85; | |
2933 | Add( StrUserBou nds2(Drawe rSplitters , frmNotes .Drawers.L astOpenSiz e, | |
2934 | frmCo nsults.Dra wers.LastO penSize, | |
2935 | frmDC Summ.Drawe rs.LastOpe nSize, | |
2936 | SurgT empHt)); / / last par ameter = C Q7315 | |
2937 | Add( StrUserBou nds2(Drawe rSplitters , frmNotes .Drawers.L astOpenSiz e, | |
2938 | frmCo nsults.Dra wers.LastO penSize, | |
2939 | frmDC Summ.Drawe rs.LastOpe nSize, | |
2940 | SurgT empHt)); | |
2941 | ||
2942 | frmN otes.SaveU serSplitte rSettings( s1, s2, s3 , s4); | |
2943 | Add( StrUserBou nds2(NoteS plitters, s1, s2, s3 , s4)); | |
2944 | ||
2945 | frmL abs.SaveUs erSettings (s1, s2, s 3, s4); | |
2946 | Add( StrUserBou nds2(LabSp litters, s 1, s2, s3, s4)); | |
2947 | ||
2948 | //Me ds Tab Spl itters | |
2949 | Add( StrUserBou nds2(frmMe ds.Name+'S plit',frmM eds.gdpOut .Height,fr mMeds.gdpI n.Height,0 ,0)); | |
2950 | ||
2951 | //Me ds Tab Non -VA meds c olumns | |
2952 | Add( StrUserCol umns(fMeds .frmMeds.h drMedsNonV A)); //CQ7 314 | |
2953 | ||
2954 | //Or ders Tab c olumns | |
2955 | Add( StrUserCol umns(fOrde rs.frmOrde rs.hdrOrde rs)); //CQ 6328 | |
2956 | ||
2957 | if E nduringPtS elSplitter Pos <> 0 t hen | |
2958 | Ad d(StrUserB ounds2('fr mPtSel.spt Vert', End uringPtSel SplitterPo s, 0, 0, 0 )); | |
2959 | if E nduringPtS elColumns <> '' then | |
2960 | Ad d('C^frmPt Sel.lstvAl erts^' + E nduringPtS elColumns) ; | |
2961 | ||
2962 | //** ** Copy/Pa ste | |
2963 | // Ad d(StrUserB ounds2('fr mNotes.Rea dOnlyEditM onitor', f rmNotes.Re adOnlyEdit Monitor.He ight, 0, 0 , 0)); // Notes savi ng is done on the no tes form. | |
2964 | end; | |
2965 | //Add sizes for forms that used Save UserBounds () to save thier pos itions | |
2966 | SizeHo lder.AddSi zesToStrLi st(SizeLis t); | |
2967 | //Send the SizeL ist to the Database | |
2968 | SaveUs erSizes(Si zeList); | |
2969 | finally | |
2970 | SizeLi st.Free; | |
2971 | end; | |
2972 | end; | |
2973 | ||
2974 | procedure TfrmFrame. FormResize (Sender: T Object); | |
2975 | { need to resize tab forms spe cifically since they don't inh erit resiz e event (b ecause the y | |
2976 | are deri ved from T Form itsel f) } | |
2977 | begin | |
2978 | if FTerm inate or F Closing th en Exit; | |
2979 | if csDes troying in Component State then Exit; | |
2980 | // These MoveWindo w methods can be pha sed out. T Form now h as TAlign property t hat set to | |
2981 | // alCli ent works perfectly well. Tfrm CoverSheet update no longer us es it. | |
2982 | //MoveWi ndow(frmCo ver.Handle , 0, 0, p nlPage.Cli entWidth, pnlPage.Cl ientHeight , True); | |
2983 | MoveWind ow(frmProb lems.Handl e, 0, 0, p nlPage.Cli entWidth, pnlPage.Cl ientHeight , True); | |
2984 | MoveWind ow(frmMeds .Handle, 0, 0, p nlPage.Cli entWidth, pnlPage.Cl ientHeight , True); | |
2985 | MoveWind ow(frmOrde rs.Handle, 0, 0, p nlPage.Cli entWidth, pnlPage.Cl ientHeight , True); | |
2986 | MoveWind ow(frmNote s.Handle, 0, 0, p nlPage.Cli entWidth, pnlPage.Cl ientHeight , True); | |
2987 | MoveWind ow(frmCons ults.Handl e, 0, 0, p nlPage.Cli entWidth, pnlPage.Cl ientHeight , True); | |
2988 | MoveWind ow(frmDCSu mm.Handle, 0, 0, p nlPage.Cli entWidth, pnlPage.Cl ientHeight , True); | |
2989 | if Assig ned(frmSur gery) then MoveWindo w(frmSurge ry.Handle, 0, 0, pnlPage.C lientWidth , pnlPage. ClientHeig ht, True); | |
2990 | MoveWind ow(frmLabs .Handle, 0, 0, p nlPage.Cli entWidth, pnlPage.Cl ientHeight , True); | |
2991 | MoveWind ow(frmRepo rts.Handle , 0, 0, p nlPage.Cli entWidth, pnlPage.Cl ientHeight , True); | |
2992 | with sts Area do | |
2993 | begin | |
2994 | Panels [1].Width := stsArea .Width - F FixedStatu sWidth; | |
2995 | FNextB uttonL := Panels[0]. Width + Pa nels[1].Wi dth; | |
2996 | FNextB uttonR := FNextButto nL + Panel s[2].Width ; | |
2997 | end; | |
2998 | if Notif ications.A ctive then SetUpNext Button; | |
2999 | lstCIRNL ocations.L eft := FN extButtonL - ScrollB arWidth - 100; | |
3000 | lstCIRNL ocations.W idth := Cl ientWidth - lstCIRNL ocations.L eft; | |
3001 | //cq: 15 641 | |
3002 | if frmFr ame.FNextB uttonActiv e then // keeps butt on aligned if cancel is presse d | |
3003 | begin | |
3004 | FNextB utton.Left := FNextB uttonL; | |
3005 | FNextB utton.Top := stsArea .Top; | |
3006 | end; | |
3007 | Self.Rep aint; | |
3008 | end; | |
3009 | ||
3010 | procedure TfrmFrame. ChangeFont (NewFontSi ze: Intege r); | |
3011 | { Makes ch anges in a ll compone nts whenev er the fon t size is changed. This is ha rdcoded an d | |
3012 | based on MS Sans S erif for n ow, as onl y the font size may be selecte d. Courier New is us ed | |
3013 | wherever non-propo rtional fo nts are re quired. } | |
3014 | const | |
3015 | TAB_VOFF SET = 7; | |
3016 | var | |
3017 | OldFont: TFont; | |
3018 | begin | |
3019 | // Ho ho! ResizeAnc horedFormT oFont(self ) doesn't work here because th e | |
3020 | // Form si ze is alia sed with M ainFormSiz e. | |
3021 | OldFont := TFont.C reate; | |
3022 | try | |
3023 | Disabl eAlign; | |
3024 | try | |
3025 | OldF ont.Assign (Font); | |
3026 | with Self do Fo nt.Size := NewFontSi ze; | |
3027 | with lblPtName do Fo nt.Size := NewFontSi ze; // m ust change BOLDED la bels by ha nd | |
3028 | with lblPtSSN do Fo nt.Size := NewFontSi ze; | |
3029 | with lblPtAge do Fo nt.Size := NewFontSi ze; | |
3030 | with lblOTHDTi tle do Fo nt.Size := NewFontSi ze; // rp k 11/28/20 17 | |
3031 | with lblOTHD do Fo nt.Size := NewFontSi ze; // rp k 11/28/20 17 | |
3032 | with lblPtLoca tion do Fo nt.Size := NewFontSi ze; | |
3033 | with lblPtProv ider do Fo nt.Size := NewFontSi ze; | |
3034 | with lblPtPost ings do Fo nt.Size := NewFontSi ze; | |
3035 | with lblPtCare do Fo nt.Size := NewFontSi ze; | |
3036 | with lblPtAtte nding do F ont.Size : = NewFontS ize; | |
3037 | with lblPtMHTC do F ont.Size : = NewFontS ize; | |
3038 | with lblFlag do Fo nt.Size := NewFontSi ze; | |
3039 | with lblPtCWAD do Fo nt.Size := NewFontSi ze; | |
3040 | with lblCIRN do Fo nt.Size := NewFontSi ze; | |
3041 | with lblVistaW eb do Fo nt.Size := NewFontSi ze; | |
3042 | with lstCIRNLo cations do | |
3043 | be gin | |
3044 | Font.Size := NewFont Size; | |
3045 | ItemHeight := NewFon tSize + 6; | |
3046 | en d; | |
3047 | with tabPage do Fo nt.Size := NewFontSi ze; | |
3048 | with laMHV do Fo nt.Size := NewFontSi ze; //VAA | |
3049 | with laVAA2 do Fo nt.Size := NewFontSi ze; //VAA | |
3050 | ||
3051 | frmF rameHeight := frmFra me.Height; | |
3052 | pnlP atientSele ctedHeight := pnlPat ientSelect ed.Height; | |
3053 | tabP age.Height := MainFo ntHeight + TAB_VOFFS ET; // r esize tab selector | |
3054 | FitT oolbar; // r esize tool bar | |
3055 | stsA rea.Font.S ize := New FontSize; | |
3056 | stsA rea.Height := MainFo ntHeight + TAB_VOFFS ET; | |
3057 | stsA rea.Panels [0].Width := ResizeW idth( OldF ont, Font, stsArea.P anels[0].W idth); | |
3058 | stsA rea.Panels [2].Width := ResizeW idth( OldF ont, Font, stsArea.P anels[2].W idth); | |
3059 | ||
3060 | Refr eshFixedSt atusWidth; | |
3061 | Form Resize( se lf ); | |
3062 | finall y | |
3063 | Enab leAlign; | |
3064 | end; | |
3065 | finally | |
3066 | OldFon t.Free; | |
3067 | end; | |
3068 | ||
3069 | case (Ne wFontSize) of | |
3070 | 8: mnu8 pt.Checked := true; | |
3071 | 10: mnu1 0pt1.Check ed := true ; | |
3072 | 12: mnu1 2pt1.Check ed := true ; | |
3073 | 14: mnu1 4pt1.Check ed := true ; | |
3074 | //18: mn u18pt1.Che cked := tr ue; | |
3075 | end; | |
3076 | ||
3077 | //Now th at the for m elements are resiz ed, the pa ges will k now what s ize to tak e. | |
3078 | ||
3079 | //frmCov erSheet.Fo nt.Size := NewFontSi ze; | |
3080 | CoverShe et.OnSetFo ntSize(Sel f, NewFont Size); | |
3081 | frmProbl ems.SetFon tSize(NewF ontSize); | |
3082 | frmMeds. SetFontSiz e(NewFontS ize); | |
3083 | frmOrder s.SetFontS ize(NewFon tSize); | |
3084 | frmNotes .SetFontSi ze(NewFont Size); | |
3085 | frmConsu lts.SetFon tSize(NewF ontSize); | |
3086 | frmDCSum m.SetFontS ize(NewFon tSize); | |
3087 | if Assig ned(frmSur gery) then frmSurger y.SetFontS ize(NewFon tSize); | |
3088 | frmLabs. SetFontSiz e(NewFontS ize); | |
3089 | frmRepor ts.SetFont Size(NewFo ntSize); | |
3090 | TfrmIcon Legend.Set FontSize(N ewFontSize ); | |
3091 | uOrders. SetFontSiz e(NewFontS ize); | |
3092 | if Assig ned(frmRem Dlg) then frmRemDlg. SetFontSiz e; | |
3093 | //if (Tf rmRemDlg.G etInstance <> nil) t hen TfrmRe mDlg.GetIn stance.Set FontSize; | |
3094 | if Assig ned(frmRem inderTree) then frmR eminderTre e.SetFontS ize(NewFon tSize); | |
3095 | if Graph Float <> n il then Re sizeAnchor edFormToFo nt(GraphFl oat); | |
3096 | end; | |
3097 | ||
3098 | procedure TfrmFrame. FitToolBar ; | |
3099 | { resizes and reposi tions the panels & l abels used in the to olbar } | |
3100 | const | |
3101 | PATIENT_ WIDTH = 29 ; | |
3102 | VISIT_WI DTH = 36 ; | |
3103 | POSTING_ WIDTH = 11 .5; | |
3104 | FLAG_WID TH = 5; | |
3105 | CV_WIDTH = 15 ; //14; WA T | |
3106 | CIRN_WID TH = 11 ; | |
3107 | MHV_WIDT H = 6; | |
3108 | LINES_HI GH2 = 2 ; | |
3109 | LINES_HI GH3 = 3 ; //lbl PtMHTC lin e change | |
3110 | M_HORIZ = 4; | |
3111 | M_MIDDLE = 2; | |
3112 | M_NVERT = 4; | |
3113 | M_WVERT = 6; | |
3114 | TINY_MAR GIN = 2; | |
3115 | begin | |
3116 | if lblPt MHTC.capti on = '' th en | |
3117 | begin | |
3118 | lblPtM HTC.Visibl e := false ; | |
3119 | pnlToo lbar.Heigh t := (LIN ES_HIGH2 * lblPtName .Height) + M_HORIZ + M_MIDDLE + M_HORIZ + M_MIDDLE | |
3120 | end | |
3121 | else | |
3122 | begin | |
3123 | if (lb lPtAttendi ng.Caption <> '') an d (lblPtAt tending.Ca ption <> l blPtMHTC.C aption) th en | |
3124 | begin | |
3125 | lblP tMHTC.Visi ble := tru e; | |
3126 | pnlT oolbar.Hei ght := (L INES_HIGH3 * lblPtNa me.Height) + M_HORIZ + M_MIDDL E + M_HORI Z + M_HORI Z; | |
3127 | end; | |
3128 | if lbl PtAttendin g.Caption = '' then | |
3129 | begin | |
3130 | lblP tAttending .Caption : = lblPtMHT C.Caption; | |
3131 | lblP tMHTC.Visi ble := fal se; | |
3132 | pnlT oolbar.Hei ght := (L INES_HIGH2 * lblPtNa me.Height) + M_HORIZ + M_MIDDL E + M_HORI Z + M_MIDD LE; | |
3133 | end; | |
3134 | end; | |
3135 | pnlPatie nt.Width := Higher Of(PATIENT _WIDTH * M ainFontWid th, lblPtN ame.Width + (M_WVERT * 2)); | |
3136 | lblPtSSN .Top := M_HORI Z + lblPtN ame.Height + M_MIDDL E; | |
3137 | lblPtAge .Top := lblPtS SN.Top; | |
3138 | lblPtAge .Left := pnlPat ient.Width - lblPtAg e.Width - M_WVERT; | |
3139 | ||
3140 | lblOTHD. Top := lblPtS SN.Top; // rpk 12/6/ 2017 | |
3141 | pnlOTHD. Width := Higher Of( (lblOT HDTitle.Wi dth + (M_W VERT * 2)) , | |
3142 | (lbl OTHD.Width + (M_WVER T * 2)) ); // rpk 1 2/6/2017 | |
3143 | lblOTHD. Left := M_WVER T; // al ign in mid dle of but ton, rpk 7 /31/2018 | |
3144 | ||
3145 | pnlVisit .Width := Higher Of(LowerOf (VISIT_WID TH * MainF ontWidth, | |
3146 | HigherOf( lblPtProvi der.Width + (M_WVERT * 2), | |
3147 | lblPtLocat ion.Width + (M_WVERT * 2))), | |
3148 | PATIENT _WIDTH * M ainFontWid th); | |
3149 | lblPtPro vider.Top := lblPtS SN.Top; | |
3150 | lblPtAtt ending.Top := lblPtS SN.Top; | |
3151 | lblPtMHT C.Top := M_MID DLE + lblP tSSN.Heigh t + lblPtS SN.Top; | |
3152 | pnlPosti ngs.Width := Round( POSTING_WI DTH * Main FontWidth) ; | |
3153 | if btnCo mbatVet.Vi sible then | |
3154 | begin | |
3155 | pnlCVn Flag.Width := Roun d(CV_WIDTH * MainFon tWidth); | |
3156 | pnlFla g.Width := Roun d(CV_WIDTH * MainFon tWidth); | |
3157 | btnCom batVet.Hei ght := Rou nd(pnlCVnF lag.Height div 2); | |
3158 | end | |
3159 | else | |
3160 | begin | |
3161 | pnlCVn Flag.Width := Roun d(FLAG_WID TH * MainF ontWidth); | |
3162 | pnlFla g.Width := Roun d(FLAG_WID TH * MainF ontWidth); | |
3163 | end; | |
3164 | pnlRemot eData.Widt h := Round (CIRN_WIDT H * MainFo ntWidth) + M_WVERT; | |
3165 | pnlVista Web.Height := pnlRem oteData.He ight div 2 ; | |
3166 | paVAA.Wi dth := Round( MHV_WIDTH * MainFont Width) + M _WVERT + 2 ; | |
3167 | pnlOTHD. Left := paVAA. Left - pnl OTHD.Width ; // posi tion OTHD panel to l eft of VAA panel, rp k 3/30/201 8 | |
3168 | ||
3169 | with lbl PtPostings do | |
3170 | SetBou nds(M_WVER T, M_HORIZ , pnlPosti ngs.Width- M_WVERT-M_ WVERT, lbl PtName.Hei ght); | |
3171 | with lbl PtCWAD do | |
3172 | SetBou nds(M_WVER T, lblPtSS N.Top, lbl PtPostings .Width, lb lPtName.He ight); | |
3173 | //Low re solution h andling: F irst, try to fit eve rything on by shrink ing fields | |
3174 | if pnlPr imaryCare. Width < Hi gherOf( lb lPtCare.Le ft + lblPt Care.Width , HigherOf (lblPtAtte nding.Left + lblPtAt tending.Wi dth,lblPtM HTC.Left + lblPtMHTC .Width)) + TINY_MARG IN then | |
3175 | //if pnl PrimaryCar e.Width < HigherOf( lblPtCare. Left + lbl PtCare.Wid th, lblPtA ttending.L eft + lblP tAttending .Width) + TINY_MARGI N then | |
3176 | begin | |
3177 | lblPtA ge.Left := lblPtAge. Left - (lb lPtName.Le ft - TINY_ MARGIN); | |
3178 | lblPtN ame.Left : = TINY_MAR GIN; | |
3179 | lblPTS SN.Left := TINY_MARG IN; | |
3180 | pnlPat ient.Width := Higher Of( lblPtN ame.Left + lblPtName .Width, lb lPtAge.Lef t + lblPtA ge.Width)+ TINY_MARG IN; | |
3181 | lblPtL ocation.Le ft := TINY _MARGIN; | |
3182 | lblPtP rovider.Le ft := TINY _MARGIN; | |
3183 | pnlVis it.Width : = HigherOf ( lblPtLoc ation.Left + lblPtLo cation.Wid th, lblPtP rovider.Le ft + lblPt Provider.W idth)+ TIN Y_MARGIN; | |
3184 | end; | |
3185 | HorzScro llBar.Rang e := 0; | |
3186 | ||
3187 | end; | |
3188 | ||
3189 | { Temporar y Calls -- ---------- ---------- ---------- ---------- ---------- ---------- ---------- -- } | |
3190 | ||
3191 | procedure TfrmFrame. ToggleMenu ItemChecke d(Sender: TObject); | |
3192 | begin | |
3193 | TMenuIte m(Sender). Checked := not TMenu Item(Sende r).Checked ; | |
3194 | end; | |
3195 | ||
3196 | {--------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------} | |
3197 | { mnuFocu sChangesCl ick - togg les the Fo cused Cont rols windo w for form s that sup port it } | |
3198 | {--------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------} | |
3199 | procedure TfrmFrame. mnuFocusCh angesClick (Sender: T Object); | |
3200 | begin | |
3201 | inherite d; | |
3202 | ShowFocu sedControl Dialog := mnuFocusCh anges.Chec ked; | |
3203 | end; | |
3204 | ||
3205 | procedure TfrmFrame. mnuFontSiz eClick(Sen der: TObje ct); | |
3206 | begin | |
3207 | if (frmR emDlg <> n il) then | |
3208 | ShowMs g('Please close the reminder d ialog befo re changin g font siz es.') | |
3209 | else if (dlgProbs <> nil) th en | |
3210 | ShowMs g('Font si ze cannot be changed while add ing or edi ting a pro blem.') | |
3211 | else beg in | |
3212 | with ( Sender as TMenuItem) do begin | |
3213 | Togg leMenuItem Checked(Se nder); | |
3214 | fMed s.oldFont := MainFon tSize; //C Q9182 | |
3215 | Chan geFont(Tag ); | |
3216 | end; | |
3217 | end; | |
3218 | end; | |
3219 | ||
3220 | procedure TfrmFrame. mnuEditCli ck(Sender: TObject); | |
3221 | var | |
3222 | IsReadOn ly: Boolea n; | |
3223 | begin | |
3224 | FEditCtr l := nil; | |
3225 | if Scree n.ActiveCo ntrol is T CustomEdit then FEdi tCtrl := T CustomEdit (Screen.Ac tiveContro l); | |
3226 | if FEdit Ctrl <> ni l then beg in | |
3227 | if FEditCtr l is TMemo then IsReadOnly := TMemo( FEditCtrl) .ReadOnly | |
3228 | else i f FEditCtr l is TEdit then IsReadOnly := TEdit( FEditCtrl) .ReadOnly | |
3229 | else i f FEditCtr l is TRich Edit then IsReadOnly := TRichE dit(FEditC trl).ReadO nly | |
3230 | else I sReadOnly := True; | |
3231 | ||
3232 | mnuEdi tRedo.Enab led := FEd itCtrl.Per form(EM_CA NREDO, 0, 0) <> 0; | |
3233 | mnuEdi tUndo.Enab led := (FE ditCtrl.Pe rform(EM_C ANUNDO, 0, 0) <> 0) and (FEdit Ctrl.Perfo rm(EM_CANR EDO, 0, 0) = 0); | |
3234 | ||
3235 | mnuEdi tCut.Enabl ed := FEdi tCtrl.SelL ength > 0; | |
3236 | mnuEdi tCopy.Enab led := mnu EditCut.En abled; | |
3237 | mnuEdi tPaste.Ena bled := (I sReadOnly = False) a nd Clipboa rd.HasForm at(CF_TEXT ); | |
3238 | end else begin | |
3239 | mnuEdi tUndo.Enab led := Fa lse; | |
3240 | mnuEdi tCut.Enabl ed := Fa lse; | |
3241 | mnuEdi tCopy.Enab led := Fa lse; | |
3242 | mnuEdi tPaste.Ena bled := Fa lse; | |
3243 | end; | |
3244 | end; | |
3245 | ||
3246 | procedure TfrmFrame. mnuEditUnd oClick(Sen der: TObje ct); | |
3247 | begin | |
3248 | FEditCtr l.Perform( EM_UNDO, 0 , 0); | |
3249 | end; | |
3250 | ||
3251 | procedure TfrmFrame. mnuEditRed oClick(Sen der: TObje ct); | |
3252 | begin | |
3253 | FEditCtr l.Perform( EM_REDO, 0 , 0); | |
3254 | end; | |
3255 | ||
3256 | ||
3257 | procedure TfrmFrame. mnuEditCut Click(Send er: TObjec t); | |
3258 | begin | |
3259 | FEditCtr l.CutToCli pboard; | |
3260 | end; | |
3261 | ||
3262 | procedure TfrmFrame. mnuEditCop yClick(Sen der: TObje ct); | |
3263 | begin | |
3264 | FEditCtr l.CopyToCl ipboard; | |
3265 | end; | |
3266 | ||
3267 | procedure TfrmFrame. mnuEditPas teClick(Se nder: TObj ect); | |
3268 | begin | |
3269 | FEditCtr l.PasteFro mClipboard ; // use AsText to prevent fo rmatting f rom being pasted | |
3270 | end; | |
3271 | ||
3272 | procedure TfrmFrame. mnuFilePri ntClick(Se nder: TObj ect); | |
3273 | begin | |
3274 | case mnu FilePrint. Tag of | |
3275 | CT_NOTES : frmNo tes.Reques tPrint; | |
3276 | CT_CONSU LTS: frmCo nsults.Req uestPrint; | |
3277 | CT_DCSUM M: frmDC Summ.Reque stPrint; | |
3278 | CT_REPOR TS: frmRe ports.Requ estPrint; | |
3279 | CT_LABS: frmLa bs.Request Print; | |
3280 | CT_ORDER S: frmOr ders.Reque stPrint; | |
3281 | CT_PROBL EMS: frmPr oblems.Req uestPrint; | |
3282 | CT_SURGE RY: if As signed(frm Surgery) t hen frmSur gery.Reque stPrint; | |
3283 | end; | |
3284 | end; | |
3285 | ||
3286 | procedure TfrmFrame. WMSysComma nd(var Mes sage: TMes sage); | |
3287 | begin | |
3288 | case Tab ToPageID(t abPage.Tab Index) of | |
3289 | CT_NOT ES: | |
3290 | if Assigned( Screen.Act iveControl .Parent) a nd (Screen .ActiveCon trol.Paren t.Name = ' cboCosigne r') then | |
3291 | with Messa ge do | |
3292 | begin | |
3293 | SendMe ssage(frmN otes.Handl e, Msg, WP aram, LPar am); | |
3294 | Result := 0; | |
3295 | end | |
3296 | el se | |
3297 | inherited; | |
3298 | CT_DCS UMM: | |
3299 | if Assigned( Screen.Act iveControl .Parent) a nd (Screen .ActiveCon trol.Paren t.Name = ' cboAttendi ng') then | |
3300 | with Messa ge do | |
3301 | begin | |
3302 | SendMe ssage(frmD CSumm.Hand le, Msg, W Param, lPa ram); | |
3303 | Result := 0; | |
3304 | end | |
3305 | el se | |
3306 | inherited; | |
3307 | CT_CON SULTS: | |
3308 | if Assigned( Screen.Act iveControl .Parent) a nd (Screen .ActiveCon trol.Paren t.Name = ' cboCosigne r') then | |
3309 | with Messa ge do | |
3310 | begin | |
3311 | SendMe ssage(frmC onsults.Ha ndle, Msg, WParam, l Param); | |
3312 | Result := 0; | |
3313 | end | |
3314 | el se | |
3315 | inherited; | |
3316 | else | |
3317 | inheri ted; | |
3318 | end; | |
3319 | if Messa ge.WParam = SC_MAXIM IZE then | |
3320 | begin | |
3321 | // for m becomes maximized; | |
3322 | frmOrd ers.mnuOpt imizeField sClick(sel f); | |
3323 | frmPro blems.mnuO ptimizeFie ldsClick(s elf); | |
3324 | frmMed s.mnuOptim izeFieldsC lick(self) ; | |
3325 | end | |
3326 | else if Message.WP aram = SC_ MINIMIZE t hen | |
3327 | begin | |
3328 | // for m becomes maximized; | |
3329 | end | |
3330 | else if Message.WP aram = SC_ RESTORE th en | |
3331 | begin | |
3332 | // for m is resto red (from maximized) ; | |
3333 | frmOrd ers.mnuOpt imizeField sClick(sel f); | |
3334 | frmPro blems.mnuO ptimizeFie ldsClick(s elf); | |
3335 | frmMed s.mnuOptim izeFieldsC lick(self) ; | |
3336 | end; | |
3337 | end; | |
3338 | ||
3339 | procedure TfrmFrame. RemindersC hanged(Sen der: TObje ct); | |
3340 | var | |
3341 | ImgName: string; | |
3342 | begin | |
3343 | pnlRemin ders.tag : = HAVE_REM INDERS; | |
3344 | pnlRemin ders.Hint := 'Click to display reminders '; | |
3345 | case Get ReminderSt atus of | |
3346 | rsUnkn own: | |
3347 | begi n | |
3348 | Im gName := ' BMP_REMIND ERS_UNKNOW N'; | |
3349 | pn lReminders .Caption : = 'Reminde rs'; | |
3350 | end; | |
3351 | rsDue: | |
3352 | begi n | |
3353 | Im gName := ' BMP_REMIND ERS_DUE'; | |
3354 | pn lReminders .Caption : = 'Due Rem inders'; | |
3355 | end; | |
3356 | rsAppl icable: | |
3357 | begi n | |
3358 | Im gName := ' BMP_REMIND ERS_APPLIC ABLE'; | |
3359 | pn lReminders .Caption : = 'Applica ble Remind ers'; | |
3360 | end; | |
3361 | rsNotA pplicable: | |
3362 | begi n | |
3363 | Im gName := ' BMP_REMIND ERS_OTHER' ; | |
3364 | pn lReminders .Caption : = 'Other R eminders'; | |
3365 | end; | |
3366 | else | |
3367 | begi n | |
3368 | Im gName := ' BMP_REMIND ERS_NONE'; | |
3369 | pn lReminders .Hint := ' There are currently no reminde rs availab le'; | |
3370 | pn lReminders .Caption : = pnlRemin ders.Hint; | |
3371 | pn lReminders .tag := NO _REMINDERS ; | |
3372 | end; | |
3373 | end; | |
3374 | if(Remin dersEvalua tingInBack ground) th en | |
3375 | begin | |
3376 | if(anm tRemSearch .ResName = '') then | |
3377 | begin | |
3378 | TORE xposedAnim ate(anmtRe mSearch).O nMouseDown := pnlRem indersMous eDown; | |
3379 | TORE xposedAnim ate(anmtRe mSearch).O nMouseUp := pnlRem indersMous eUp; | |
3380 | anmt RemSearch. ResHandle := 0; | |
3381 | anmt RemSearch. ResName := 'REMSEARC HAVI'; | |
3382 | end; | |
3383 | imgRem inder.Visi ble := FAL SE; | |
3384 | anmtRe mSearch.Ac tive := TR UE; | |
3385 | anmtRe mSearch.Vi sible := T RUE; | |
3386 | if(pnl Reminders. Hint <> '' ) then | |
3387 | pnlR eminders.H int := CRL F + pnlRem inders.Hin t + '.'; | |
3388 | pnlRem inders.Hin t := 'Eval uating Rem inders... ' + pnlRe minders.Hi nt; | |
3389 | pnlRem inders.Cap tion := pn lReminders .Hint; | |
3390 | end | |
3391 | else | |
3392 | begin | |
3393 | anmtRe mSearch.Vi sible := F ALSE; | |
3394 | imgRem inder.Visi ble := TRU E; | |
3395 | imgRem inder.Pict ure.Bitmap .LoadFromR esourceNam e(hInstanc e, ImgName ); | |
3396 | anmtRe mSearch.Ac tive := FA LSE; | |
3397 | end; | |
3398 | mnuViewR eminders.E nabled := (pnlRemind ers.tag = HAVE_REMIN DERS); | |
3399 | end; | |
3400 | ||
3401 | procedure TfrmFrame. pnlReminde rsMouseDow n(Sender: TObject; | |
3402 | Button: TMouseButt on; Shift: TShiftSta te; X, Y: Integer); | |
3403 | begin | |
3404 | if(not I nitialRemi ndersLoade d) then | |
3405 | Startu pReminders ; | |
3406 | if(pnlRe minders.ta g = HAVE_R EMINDERS) then | |
3407 | pnlRem inders.Bev elOuter := bvLowered ; | |
3408 | end; | |
3409 | ||
3410 | procedure TfrmFrame. pnlReminde rsMouseUp( Sender: TO bject; | |
3411 | Button: TMouseButt on; Shift: TShiftSta te; X, Y: Integer); | |
3412 | begin | |
3413 | pnlRemin ders.Bevel Outer := b vRaised; | |
3414 | if(pnlRe minders.ta g = HAVE_R EMINDERS) then | |
3415 | ViewIn fo(mnuView Reminders) ; | |
3416 | end; | |
3417 | ||
3418 | //-------- ---------- --- CIRN-r elated pro cedures -- ---------- ---------- ---------- | |
3419 | ||
3420 | procedure TfrmFrame. SetUpCIRN; | |
3421 | var | |
3422 | i: integ er; | |
3423 | iNwHIN, iRDVOnly: integer; | |
3424 | aAutoQue ry,aVistaW ebLabel: s tring; | |
3425 | ASite: T RemoteSite ; | |
3426 | item: TV A508Access ibilityIte m; | |
3427 | id: inte ger; | |
3428 | begin | |
3429 | uUseVist aWeb := fa lse; | |
3430 | with Rem oteSites d o | |
3431 | begin | |
3432 | Change Patient(Pa tient.DFN) ; | |
3433 | lblCIR N.Caption := ' Remot e Data'; | |
3434 | lblCIR N.Alignmen t := taCen ter; | |
3435 | aVista WebLabel : = GetVista Web_JLV_La belName; | |
3436 | if aVi staWebLabe l = '' the n aVistaWe bLabel := 'VistAWeb' ; | |
3437 | lblVis taWeb.Capt ion := aVi staWebLabe l; | |
3438 | pnlVis taWeb.Beve lOuter := bvRaised; | |
3439 | iNwHIN := 0; | |
3440 | iRDVOn ly := 0; | |
3441 | for i := 0 to Re moteSites. Count - 1 do | |
3442 | begi n | |
3443 | if not(LeftS tr(TRemote Site(Remot eSites.Sit eList.Item s[i]).Site ID, 4) = ' 200N') the n | |
3444 | begin | |
3445 | iRDVOnly := 1; | |
3446 | continue ; | |
3447 | end | |
3448 | el se | |
3449 | iNwHIN := 1; | |
3450 | end; | |
3451 | ||
3452 | if Rem oteDataExi sts and (( iRDVOnly = 1) or (iN wHIN = 1)) and (Remo teSites.Co unt > 0) t hen | |
3453 | begi n | |
3454 | if ScreenRea derSystemA ctive then | |
3455 | be gin | |
3456 | i tem := amg rMain.Acce ssData.Fin dItem(pnlR emoteData, False); | |
3457 | i d:= item.I NDEX; | |
3458 | a mgrMain.Ac cessData[i d].AccessT ext := ''; | |
3459 | en d; | |
3460 | lb lCIRN.Enab led := True; | |
3461 | pn lCIRN.TabS top := True; | |
3462 | lb lCIRN.Font .Color := Get508Com pliantColo r(clBlue); | |
3463 | ls tCIRNLocat ions.Font. Color := Get508Comp liantColor (clBlue); | |
3464 | lb lCIRN.Capt ion := 'Re mote Data' ; | |
3465 | pn lCIRN.Hint := 'Click to displa y other fa cilities h aving data for this patient.'; | |
3466 | lb lVistaWeb. Font.Color := Get508 CompliantC olor(clBlu e); | |
3467 | pn lVistaWeb. Hint := 'C lick to go to ' + aV istaWebLab el + ' to see data f rom other facilities for this patient.'; | |
3468 | if RemoteSit es.Count > 0 then | |
3469 | lstCIRNLoc ations.Ite ms.Add('0' + U + 'Al l Availabl e Sites'); | |
3470 | fo r i := 0 t o RemoteSi tes.Count - 1 do | |
3471 | begin | |
3472 | ASite := TRemoteSi te(SiteLis t[i]); | |
3473 | lstCIRNL ocations.I tems.Add(A Site.SiteI D + U + AS ite.SiteNa me + U + | |
3474 | Format FMDateTime ('mmm dd y yyy hh:nn' , ASite.La stDate)); | |
3475 | end; | |
3476 | end | |
3477 | else | |
3478 | begi n | |
3479 | if ScreenRea derSystemA ctive then | |
3480 | be gin | |
3481 | i tem := amg rMain.Acce ssData.Fin dItem(pnlR emoteData, False); | |
3482 | i d:= item.I NDEX; | |
3483 | a mgrMain.Ac cessData[i d].AccessT ext := 'No remote da ta availab le'; | |
3484 | en d; | |
3485 | lb lCIRN.Font .Color := clWindowT ext; | |
3486 | lb lVistaWeb. Font.Color := clWind owText; | |
3487 | lb lCIRN.Enab led := False; | |
3488 | pn lCIRN.TabS top := False; | |
3489 | pn lCIRN.Hint := NoData Reason; | |
3490 | if (iNwHIN = 1) and (i RDVOnly = 0) then | |
3491 | begin | |
3492 | lblVistaW eb.Font.Co lor := Get 508Complia ntColor(cl Blue); | |
3493 | pnlVistaW eb.Hint := 'Click to go to ' + aVistaWeb Label + ' to see dat a from oth er facilit ies for th is patient (includes Non-VA da ta).'; | |
3494 | end; | |
3495 | end; | |
3496 | aAutoQ uery := Au toRDV; //Chec k to see i f Remote Q ueries sho uld be use d for all available sites | |
3497 | if (aA utoQuery = '1') and (lstCIRNLo cations.Co unt > 0) t hen | |
3498 | begi n | |
3499 | ls tCIRNLocat ions.ItemI ndex := 0; | |
3500 | ls tCIRNLocat ions.Check ed[0] := t rue; | |
3501 | ls tCIRNLocat ionsClick( self); | |
3502 | end; | |
3503 | end; | |
3504 | end; | |
3505 | ||
3506 | procedure TfrmFrame. paVAAResiz e(Sender: TObject); | |
3507 | begin | |
3508 | laMHV.He ight := pa VAA.Client Height div 2; | |
3509 | end; | |
3510 | ||
3511 | procedure TfrmFrame. pnlCIRNCli ck(Sender: TObject); | |
3512 | begin | |
3513 | ViewInfo (mnuViewRe moteData); | |
3514 | end; | |
3515 | ||
3516 | procedure TfrmFrame. lstCIRNLoc ationsClic k(Sender: TObject); | |
3517 | var | |
3518 | iIndex,j ,iAll,iCur : integer; | |
3519 | aMsg,s: string; | |
3520 | AccessSt atus: inte ger; | |
3521 | begin | |
3522 | iAll := 1; | |
3523 | AccessSt atus := 0; | |
3524 | iIndex : = lstCIRNL ocations.I temIndex; | |
3525 | if not C heckHL7TCP Link then | |
3526 | begin | |
3527 | Info Box('Local HL7 TCP L ink is dow n.' + CRLF + 'Unable to retrie ve remote data.', TC _DGSR_ERR, MB_OK); | |
3528 | lstC IRNLocatio ns.Checked [iIndex] : = false; | |
3529 | Exit ; | |
3530 | end; | |
3531 | if lstCI RNLocation s.Items.Co unt > 1 th en | |
3532 | if pie ce(lstCIRN Locations. Items[1],' ^',1) = '0 ' then | |
3533 | iAll := 2; | |
3534 | with frm Reports do | |
3535 | if pie ce(uRemote Type,'^',2 ) = 'V' th en | |
3536 | begi n | |
3537 | lv Reports.It ems.BeginU pdate; | |
3538 | lv Reports.It ems.Clear; | |
3539 | lv Reports.Co lumns.Clea r; | |
3540 | lv Reports.It ems.EndUpd ate; | |
3541 | end; | |
3542 | uReportI nstruction := ''; | |
3543 | frmRepor ts.TabCont rol1.Tabs. Clear; | |
3544 | frmLabs. TabControl 1.Tabs.Cle ar; | |
3545 | frmRepor ts.TabCont rol1.Tabs. AddObject( 'Local',ni l); | |
3546 | frmLabs. TabControl 1.Tabs.Add Object('Lo cal',nil); | |
3547 | StatusTe xt('Checki ng Remote Sites...') ; | |
3548 | if piece (lstCIRNLo cations.It ems[iIndex ],'^',1) = '0' then // All sit es have be en clicked | |
3549 | if lst CIRNLocati ons.Checke d[iIndex] = false th en // All selection is being t urned off | |
3550 | begi n | |
3551 | wi th RemoteS ites.SiteL ist do | |
3552 | fo r j := 0 t o Count - 1 do | |
3553 | if lstCIRN Locations. Checked[j+ 1] = true then | |
3554 | begin | |
3555 | lstCIR NLocations .Checked[j +1] := fal se; | |
3556 | TRemot eSite(Remo teSites.Si teList[j]) .Selected := false; | |
3557 | TRemot eSite(Remo teSites.Si teList[j]) .ReportCle ar; | |
3558 | TRemot eSite(Remo teSites.Si teList[j]) .LabClear; | |
3559 | end; | |
3560 | end | |
3561 | else | |
3562 | begi n | |
3563 | wi th RemoteS ites.SiteL ist do | |
3564 | fo r j := 0 t o Count - 1 do | |
3565 | begin | |
3566 | Screen .Cursor := crHourGla ss; | |
3567 | Screen .Cursor := crDefault ; | |
3568 | aMsg : = aMsg + ' at site: ' + TRemot eSite(Item s[j]).Site Name; | |
3569 | s := l stCIRNLoca tions.Item s[j+1]; | |
3570 | lstCIR NLocations .Items[j+1 ] := piece s(s, '^', 1, 3); | |
3571 | case A ccessStatu s of | |
3572 | DGSR_F AIL: begin | |
3573 | if piece(aMsg ,':',1) = 'RPC name not found at site' t hen //Allo w for back ward compa tibility | |
3574 | b egin | |
3575 | lstCIRNLo cations.Ch ecked[j+1] := true; | |
3576 | TRemoteSi te(RemoteS ites.SiteL ist[j]).Re portClear; | |
3577 | TRemoteSi te(RemoteS ites.SiteL ist[j]).La bClear; | |
3578 | TRemoteSi te(Items[j ]).Selecte d := true; | |
3579 | e nd | |
3580 | els e | |
3581 | b egin | |
3582 | InfoBox(a Msg, TC_DG SR_ERR, MB _OK); | |
3583 | lstCIRNLo cations.Ch ecked[j+1] := false; | |
3584 | lstCIRNLo cations.It ems[j+1] : = pieces(s , '^', 1, 3) + '^' + TC_DGSR_E RR; | |
3585 | TRemoteSi te(Items[j ]).Selecte d := false ; | |
3586 | Continue; | |
3587 | e nd; | |
3588 | end; | |
3589 | DGSR_N ONE: begin | |
3590 | lst CIRNLocati ons.Checke d[j+1] := true; | |
3591 | TRe moteSite(R emoteSites .SiteList[ j]).Report Clear; | |
3592 | TRe moteSite(R emoteSites .SiteList[ j]).LabCle ar; | |
3593 | TRe moteSite(I tems[j]).S elected := true; | |
3594 | end; | |
3595 | DGSR_S HOW: begin | |
3596 | Inf oBox(AMsg, TC_DGSR_S HOW, MB_OK ); | |
3597 | lst CIRNLocati ons.Checke d[j+1] := true; | |
3598 | TRe moteSite(R emoteSites .SiteList[ j]).Report Clear; | |
3599 | TRe moteSite(R emoteSites .SiteList[ j]).LabCle ar; | |
3600 | TRe moteSite(I tems[j]).S elected := true; | |
3601 | end; | |
3602 | DGSR_A SK: if In foBox(AMsg + TX_DGSR _YESNO, TC _DGSR_SHOW , MB_YESNO or MB_ICO NWARNING o r | |
3603 | MB_ DEFBUTTON2 ) = IDYES then | |
3604 | beg in | |
3605 | l stCIRNLoca tions.Chec ked[j+1] : = true; | |
3606 | T RemoteSite (RemoteSit es.SiteLis t[j]).Repo rtClear; | |
3607 | T RemoteSite (RemoteSit es.SiteLis t[j]).LabC lear; | |
3608 | T RemoteSite (Items[j]) .Selected := true; | |
3609 | end | |
3610 | els e | |
3611 | b egin | |
3612 | lstCIRNLo cations.Ch ecked[j+1] := false; | |
3613 | lstCIRNLo cations.It ems[j+1] : = pieces(s , '^', 1, 3) + '^' + TC_DGSR_S HOW; | |
3614 | TRemoteSi te(Items[j ]).Selecte d := false ; | |
3615 | Continue; | |
3616 | e nd; | |
3617 | else begin | |
3618 | Inf oBox(AMsg, TC_DGSR_D ENY, MB_OK ); | |
3619 | lst CIRNLocati ons.Checke d[j+1] := false; | |
3620 | lst CIRNLocati ons.Items[ j+1] := pi eces(s, '^ ', 1, 3) + '^' + TC_ DGSR_DENY; | |
3621 | TRe moteSite(I tems[j]).S elected := false; | |
3622 | Con tinue; | |
3623 | end; | |
3624 | end; | |
3625 | end; | |
3626 | end | |
3627 | else | |
3628 | begin | |
3629 | if i Index > 0 then | |
3630 | be gin | |
3631 | iCur := iI ndex - iAl l; | |
3632 | TRemoteSit e(RemoteSi tes.SiteLi st[iCur]). Selected : = | |
3633 | lstCIRNL ocations.C hecked[iIn dex]; | |
3634 | if lstCIRN Locations. Checked[iI ndex] = tr ue then | |
3635 | with Rem oteSites.S iteList do | |
3636 | begin | |
3637 | Screen .Cursor := crHourGla ss; | |
3638 | Screen .Cursor := crDefault ; | |
3639 | aMsg : = aMsg + ' at site: ' + TRemot eSite(Item s[iCur]).S iteName; | |
3640 | s := l stCIRNLoca tions.Item s[iIndex]; | |
3641 | lstCIR NLocations .Items[iIn dex] := pi eces(s, '^ ', 1, 3); | |
3642 | case A ccessStatu s of | |
3643 | DGSR_F AIL: begin | |
3644 | if piece(aMsg ,':',1) = 'RPC name not found at site' t hen //Allo w for back ward compa tibility | |
3645 | b egin | |
3646 | lstCIRNLo cations.Ch ecked[iInd ex] := tru e; | |
3647 | TRemoteSi te(RemoteS ites.SiteL ist[iCur]) .ReportCle ar; | |
3648 | TRemoteSi te(RemoteS ites.SiteL ist[iCur]) .LabClear; | |
3649 | TRemoteSi te(Items[i Cur]).Sele cted := tr ue; | |
3650 | e nd | |
3651 | els e | |
3652 | b egin | |
3653 | InfoBox(a Msg, TC_DG SR_ERR, MB _OK); | |
3654 | lstCIRNLo cations.Ch ecked[iInd ex] := fal se; | |
3655 | lstCIRNLo cations.It ems[iIndex ] := piece s(s, '^', 1, 3) + '^ ' + TC_DGS R_ERR; | |
3656 | TRemoteSi te(Items[i Cur]).Sele cted := fa lse; | |
3657 | e nd; | |
3658 | end; | |
3659 | DGSR_N ONE: begin | |
3660 | lst CIRNLocati ons.Checke d[iIndex] := true; | |
3661 | TRe moteSite(R emoteSites .SiteList[ iCur]).Rep ortClear; | |
3662 | TRe moteSite(R emoteSites .SiteList[ iCur]).Lab Clear; | |
3663 | TRe moteSite(I tems[iCur] ).Selected := true; | |
3664 | end; | |
3665 | DGSR_S HOW: begin | |
3666 | Inf oBox(AMsg, TC_DGSR_S HOW, MB_OK ); | |
3667 | lst CIRNLocati ons.Checke d[iIndex] := true; | |
3668 | TRe moteSite(R emoteSites .SiteList[ iCur]).Rep ortClear; | |
3669 | TRe moteSite(R emoteSites .SiteList[ iCur]).Lab Clear; | |
3670 | TRe moteSite(I tems[iCur] ).Selected := true; | |
3671 | end; | |
3672 | DGSR_A SK: if In foBox(AMsg + TX_DGSR _YESNO, TC _DGSR_SHOW , MB_YESNO or MB_ICO NWARNING o r | |
3673 | MB_ DEFBUTTON2 ) = IDYES then | |
3674 | beg in | |
3675 | l stCIRNLoca tions.Chec ked[iIndex ] := true; | |
3676 | T RemoteSite (RemoteSit es.SiteLis t[iCur]).R eportClear ; | |
3677 | T RemoteSite (RemoteSit es.SiteLis t[iCur]).L abClear; | |
3678 | T RemoteSite (Items[iCu r]).Select ed := true ; | |
3679 | end | |
3680 | els e | |
3681 | b egin | |
3682 | lstCIRNLo cations.Ch ecked[iInd ex] := fal se; | |
3683 | lstCIRNLo cations.It ems[iIndex ] := piece s(s, '^', 1, 3) + '^ ' + TC_DGS R_SHOW; | |
3684 | e nd; | |
3685 | else begin | |
3686 | Inf oBox(AMsg, TC_DGSR_D ENY, MB_OK ); | |
3687 | lst CIRNLocati ons.Checke d[iIndex] := false; | |
3688 | lst CIRNLocati ons.Items[ iIndex] := pieces(s, '^', 1, 3 ) + '^' + TC_DGSR_DE NY; | |
3689 | TRe moteSite(I tems[iCur] ).Selected := false; | |
3690 | end; | |
3691 | end; | |
3692 | with f rmReports do | |
3693 | if p iece(uRemo teType,'^' ,1) = '1' then | |
3694 | if not(piece (uRemoteTy pe,'^',2) = 'V') the n | |
3695 | begin | |
3696 | TabContr ol1.Visibl e := true; | |
3697 | pnlRight Top.Height := lblTit le.Height + TabContr ol1.Height ; | |
3698 | end; | |
3699 | with f rmLabs do | |
3700 | if p iece(uLabR emoteType, '^',1) = ' 1' then | |
3701 | if not(piece (uLabRemot eType,'^', 2) = 'V') then | |
3702 | begin | |
3703 | TabContr ol1.Visibl e := true; | |
3704 | pnlRight Top.Height := lblTit le.Height + TabContr ol1.Height ; | |
3705 | end; | |
3706 | end; | |
3707 | en d; | |
3708 | end; | |
3709 | with Rem oteSites.S iteList do | |
3710 | for j := 0 to Co unt - 1 do | |
3711 | if T RemoteSite (Items[j]) .Selected | |
3712 | an d (not(Lef tStr(TRemo teSite(Ite ms[j]).Sit eID ,4) = '200N')) then | |
3713 | be gin | |
3714 | frmReports .TabContro l1.Tabs.Ad dObject(TR emoteSite( Items[j]). SiteName, | |
3715 | TRemoteS ite(Items[ j])); | |
3716 | frmLabs.Ta bControl1. Tabs.AddOb ject(TRemo teSite(Ite ms[j]).Sit eName, | |
3717 | TRemoteS ite(Items[ j])); | |
3718 | en d; | |
3719 | if not(P iece(uRepo rtID,':',1 ) = 'OR_VW AL') | |
3720 | and no t(Piece(uR eportID,': ',1) = 'OR _VWRX') | |
3721 | and no t(Piece(uR eportID,': ',1) = 'OR _VWVS') | |
3722 | and (f rmReports. tvReports. SelectionC ount > 0) then frmRe ports.tvRe portsClick (self); | |
3723 | if not(u LabRepID = '6:GRAPH' ) and not( uLabRepID = '5:WORKS HEET') | |
3724 | and no t(uLabRepI D = '4:SEL ECTED TEST S BY DATE' ) | |
3725 | and (f rmLabs.tvR eports.Sel ectionCoun t > 0) the n frmLabs. tvReportsC lick(self) ; | |
3726 | StatusTe xt(''); | |
3727 | end; | |
3728 | ||
3729 | procedure TfrmFrame. popCIRNClo seClick(Se nder: TObj ect); | |
3730 | begin | |
3731 | lstCIRNL ocations.V isible := False; | |
3732 | lstCirnL ocations.S endToBack; | |
3733 | pnlCIRN. BevelOuter := bvRais ed; | |
3734 | end; | |
3735 | ||
3736 | procedure TfrmFrame. popCIRNSel ectAllClic k(Sender: TObject); | |
3737 | ||
3738 | begin | |
3739 | lstCIRNL ocations.I temIndex : = 0; | |
3740 | lstCIRNL ocations.C hecked[0] := true; | |
3741 | lstCIRNL ocations.O nClick(Sel f); | |
3742 | end; | |
3743 | ||
3744 | procedure TfrmFrame. popCIRNSel ectNoneCli ck(Sender: TObject); | |
3745 | ||
3746 | begin | |
3747 | lstCIRNL ocations.I temIndex : = 0; | |
3748 | lstCIRNL ocations.C hecked[0] := false; | |
3749 | lstCIRNL ocations.O nClick(Sel f); | |
3750 | end; | |
3751 | ||
3752 | procedure TfrmFrame. mnuFilePri ntSetupCli ck(Sender: TObject); | |
3753 | var | |
3754 | CurrPrt: string; | |
3755 | begin | |
3756 | CurrPrt := SelectD evice(Self , Encounte r.Location , True, 'P rint Devic e Selectio n'); | |
3757 | User.Cur rentPrinte r := Piece (CurrPrt, U, 1); | |
3758 | end; | |
3759 | ||
3760 | procedure TfrmFrame. LabInfo1Cl ick(Sender : TObject) ; | |
3761 | begin | |
3762 | ExecuteL abInfo; | |
3763 | end; | |
3764 | ||
3765 | procedure TfrmFrame. mnuFileNot ifRemoveCl ick(Sender : TObject) ; | |
3766 | const | |
3767 | TC_REMOV E_ALERT = 'Remove C urrent Ale rt'; | |
3768 | TX_REMOV E_ALERT1 = 'This act ion will d elete the alert you are curren tly proces sing; the alert will ' + CRLF + | |
3769 | 'd isappear a utomatical ly when al l orders h ave been a cted on, b ut this ac tion may' + CRLF + | |
3770 | 'b e used to remove the alert if some order s are to b e left unc hanged.' + CRLF + CR LF + | |
3771 | 'Y our '; | |
3772 | TX_REMOV E_ALERT2 = ' alert f or '; | |
3773 | TX_REMOV E_ALERT3 = ' will be deleted!' + CRLF + CRLF + 'Ar e you sure ?'; | |
3774 | var | |
3775 | AlertMsg , AlertTyp e: string; | |
3776 | ||
3777 | procedur e StopProc essingNoti fs; | |
3778 | begin | |
3779 | Noti fications. Clear; | |
3780 | FNex tButtonAct ive := Fal se; | |
3781 | stsA rea.Panels [2].Bevel := pbLower ed; | |
3782 | mnuF ileNext.En abled := F alse; | |
3783 | mnuF ileNotifRe move.Enabl ed := Fals e; | |
3784 | end; | |
3785 | ||
3786 | begin | |
3787 | if not N otificatio ns.Active then Exit; | |
3788 | case Not ifications .Followup of | |
3789 | NF_MED ICATIONS_E XPIRING_IN PT : Al ertType := 'Expiring Medicatio ns'; | |
3790 | NF_MED ICATIONS_E XPIRING_OU TPT : Al ertType := 'Expiring Medicatio ns'; | |
3791 | NF_ORD ER_REQUIRE S_ELEC_SIG NATURE: Al ertType := 'Unsigned Orders'; | |
3792 | NF_FLA GGED_ORDER S : Al ertType := 'Flagged Orders (fo r clarific ation)'; | |
3793 | NF_UNV ERIFIED_ME DICATION_O RDER : Al ertType := 'Unverifi ed Medicat ion Order' ; | |
3794 | NF_UNV ERIFIED_OR DER : Al ertType := 'Unverifi ed Order'; | |
3795 | NF_FLA GGED_OI_EX P_INPT : Al ertType := 'Flagged Orderable Item (INPT )'; | |
3796 | NF_FLA GGED_OI_EX P_OUTPT : Al ertType := 'Flagged Orderable Item (OUTP T)'; | |
3797 | else | |
3798 | Exit; | |
3799 | end; | |
3800 | AlertMsg := TX_REM OVE_ALERT1 + AlertTy pe + TX_RE MOVE_ALERT 2 + Patien t.Name + T X_REMOVE_A LERT3; | |
3801 | if InfoB ox(AlertMs g, TC_REMO VE_ALERT, MB_YESNO) = ID_YES t hen | |
3802 | begin | |
3803 | Noti fications. DeleteForC urrentUser ; | |
3804 | Noti fications. Next; // avoid pro mpt if no more alert s selected to proces s {v14a R V} | |
3805 | if N otificatio ns.Active then | |
3806 | be gin | |
3807 | if (InfoBo x(TX_NOTIF _STOP, TC_ NOTIF_STOP , MB_YESNO ) = ID_NO) then | |
3808 | begin | |
3809 | Notifi cations.Pr ior; | |
3810 | mnuFil eNextClick (Self); | |
3811 | end | |
3812 | else | |
3813 | StopProc essingNoti fs; | |
3814 | en d | |
3815 | else | |
3816 | St opProcessi ngNotifs; | |
3817 | end; | |
3818 | end; | |
3819 | ||
3820 | procedure TfrmFrame. mnuToolsOp tionsClick (Sender: T Object); | |
3821 | // persona l preferen ces - chan ges may ne ed to be a pplied to chart | |
3822 | var | |
3823 | i: integ er; | |
3824 | begin | |
3825 | i := 0; | |
3826 | DialogOp tions(i); | |
3827 | end; | |
3828 | ||
3829 | procedure TfrmFrame. LoadUserPr eferences; | |
3830 | begin | |
3831 | LoadSize sForUser; | |
3832 | GetUserT emplateDef aults(TRUE ); | |
3833 | end; | |
3834 | ||
3835 | procedure TfrmFrame. SaveUserPr eferences; | |
3836 | begin | |
3837 | SaveSize sForUser; // position & size set tings | |
3838 | SaveUser TemplateDe faults; | |
3839 | end; | |
3840 | ||
3841 | procedure TfrmFrame. mnuFileRef reshClick( Sender: TO bject); | |
3842 | begin | |
3843 | FRefresh ing := TRU E; | |
3844 | try | |
3845 | mnuFil eOpenClick (Self); | |
3846 | finally | |
3847 | FRefre shing := F ALSE; | |
3848 | OrderP rintForm : = FALSE; | |
3849 | end; | |
3850 | end; | |
3851 | ||
3852 | procedure TfrmFrame. AppActivat ed(Sender: TObject); | |
3853 | begin | |
3854 | if assig ned(FOldAc tivate) th en | |
3855 | FOldAc tivate(Sen der); | |
3856 | SetActiv eWindow(Ap plication. Handle); | |
3857 | if Scree nReaderSys temActive and assign ed(Patient ) and (Pat ient.Name <> '') and (Patient. Status <> '') then | |
3858 | Spea kTabAndPat ient; | |
3859 | end; | |
3860 | ||
3861 | // close T reatment F actor hint window if alt-tab p ressed. | |
3862 | procedure TfrmFrame. AppDeActiv ated(Sende r: TObject ); | |
3863 | begin | |
3864 | if FRVTF hintWindow Active the n | |
3865 | begin | |
3866 | FRVTF HintWindow .ReleaseHa ndle; | |
3867 | FRVTF HintWindow Active := False; | |
3868 | end | |
3869 | else | |
3870 | if FOSTF HintWndAct ive then | |
3871 | begin | |
3872 | FOSTF hintWindow .ReleaseHa ndle; | |
3873 | FOSTF HintWndAct ive := Fal se ; | |
3874 | end; | |
3875 | if FHint WinActive then // graphing - hints on values | |
3876 | begin | |
3877 | FHintW in.Release Handle; | |
3878 | FHintW inActive : = false; | |
3879 | end; | |
3880 | end; | |
3881 | ||
3882 | procedure TfrmFrame. LoadBuffer (Sender: T Object; Lo adList: TS trings; va r ProcessL oad: Boole an); | |
3883 | Var | |
3884 | IPAddr: string; | |
3885 | begin | |
3886 | inherite d; | |
3887 | //Load the buffe r | |
3888 | CPAppMon. UserDuz := User.DUZ; //Current User's DU Z | |
3889 | IPAddr := DottedIPS tr; | |
3890 | CallVistA ('ORWTIU P OLL', [Use r.DUZ, IPA ddr, IntTo Hex(frmFra me.Handle, 8)], Load List); | |
3891 | if Piece( LoadList.V alues['(0, 0)'], '^', 1) = '-1' then | |
3892 | begin | |
3893 | ProcessL oad := fal se; | |
3894 | CPAppMon .StopTheBu ffer; | |
3895 | end else | |
3896 | ProcessL oad := tru e; | |
3897 | end; | |
3898 | ||
3899 | procedure TfrmFrame. LoadProper ties(Sende r: TObject ); | |
3900 | Var | |
3901 | SavedStyl es, DivID, WrdRet, T mp: String ; | |
3902 | begin | |
3903 | //Load t he paramet ers | |
3904 | with CPA ppMon do b egin | |
3905 | //Check if the bu ffer has a lread load ed | |
3906 | DivID : = GetDivis ionID; | |
3907 | CallVis tA('ORWTIU WRDCOPY', [DivID],W rdRet); | |
3908 | NumberO fWordsToBe gin := Str ToFloatDef (Piece(Wrd Ret, '^', 1), 0); | |
3909 | ||
3910 | CallVis tA('ORWTIU PCTCOPY', [DivID], Tmp); | |
3911 | Percent ToVerify : = (StrToFl oatDef(Tmp , 0) * 100 ); | |
3912 | ||
3913 | //Is su per user? | |
3914 | CallVis tA('ORWTIU VIEWCOPY' , [User.DU Z, 0, DivI d], Tmp); | |
3915 | SuperUs er := Trim (Tmp) = '2 '; | |
3916 | ||
3917 | //load the exlcud ed apps | |
3918 | GetUser ListParam( ExcludeApp s, 'ORQQTI U COPY/PAS TE EXCLUDE APP'); | |
3919 | ||
3920 | //load the match text prope rties | |
3921 | CallVis tA('ORWTIU LDCPIDNT' , [nil], S avedStyles ); | |
3922 | ||
3923 | Display Paste := T rim(SavedS tyles) <> '-1;Visual Disable O verride'; | |
3924 | CPAppMo n.Enabled := Trim(Sa vedStyles) <> '-2'; | |
3925 | ||
3926 | if Disp layPaste a nd CPAppMo n.Enabled then begin | |
3927 | if Sav edStyles < > '' then begin | |
3928 | if (P iece(Saved Styles, ', ', 1) = '1 ') then | |
3929 | Matc hStyle := MatchStyle + [fsBold ]; | |
3930 | if (P iece(Saved Styles, ', ', 2) = '1 ') then | |
3931 | Matc hStyle := MatchStyle + [fsItal ic]; | |
3932 | if (P iece(Saved Styles, ', ', 3) = '1 ') then | |
3933 | Matc hStyle := MatchStyle + [fsUnde rline]; | |
3934 | ||
3935 | Match Highlight := (Piece (SavedStyl es, ',', 4 ) = '1'); | |
3936 | Highl ightColor := StrToIn tDef(Piece (SavedStyl es, ',', 5 ), clYello w); | |
3937 | ||
3938 | //LCS | |
3939 | LCSTo ggle := (P iece(Saved Styles, ', ', 6) = '1 '); | |
3940 | if (P iece(Saved Styles, ', ', 7) = '1 ') then | |
3941 | LCST extStyle : = LCSTextS tyle + [fs Bold]; | |
3942 | if (P iece(Saved Styles, ', ', 8) = '1 ') then | |
3943 | LCST extStyle : = LCSTextS tyle + [fs Italic]; | |
3944 | if (P iece(Saved Styles, ', ', 9) = '1 ') then | |
3945 | LCST extStyle : = LCSTextS tyle + [fs Underline] ; | |
3946 | ||
3947 | LCSUs eColor := (Piece(Sa vedStyles, ',', 10) = '1'); | |
3948 | LCSTe xtColor := StrToIntD ef(Piece(S avedStyles , ',', 11) , clRed); | |
3949 | LCSCh arLimit := StrToIntD ef(Piece(S avedStyles , ',', 12) , 0) | |
3950 | end; | |
3951 | end; | |
3952 | ||
3953 | end; | |
3954 | end; | |
3955 | ||
3956 | procedure TfrmFrame. SaveBuffer (Sender: T Object; Sa veList: TS tringList; | |
3957 | var Retu rnList: TS tringList) ; | |
3958 | var | |
3959 | I, X, Z, TotalBuff er, LineCn t, SubLine Cnt: Integ er; | |
3960 | Division ID, aName, aValue: s tring; | |
3961 | aList: i ORNetMult; | |
3962 | LookUpLs t: THashed StringList ; | |
3963 | begin | |
3964 | inherite d; | |
3965 | TotalBuf fer := Str ToIntDef(S aveList.Va lues['Tota lBufferToS ave'], -1) ; | |
3966 | Division ID := GetD ivisionID; | |
3967 | If Total Buffer > - 1 then | |
3968 | begin | |
3969 | LookUp Lst := THa shedString List.Creat e; | |
3970 | try | |
3971 | Look UpLst.Begi nUpdate; | |
3972 | Look UpLst.Assi gn(SaveLis t); | |
3973 | Look UpLst.EndU pdate; | |
3974 | ||
3975 | newo rNetMult(a List); | |
3976 | ||
3977 | for I := 1 to TotalBuffe r do | |
3978 | begi n | |
3979 | aL ist.AddSub script([I, 0], LookU pLst.Value s[IntToStr (I) + ',0' ]); | |
3980 | ||
3981 | Li neCnt := S trToIntDef (LookUpLst .Values[In tToStr(I) + ',-1'], -1); | |
3982 | fo r X := 1 t o LineCnt - 1 do | |
3983 | be gin | |
3984 | SubLineCnt := | |
3985 | StrToInt Def(LookUp Lst.Values [IntToStr( I) + ',' + IntToStr( X + 1) + | |
3986 | ',-1'], -1); | |
3987 | if SubLine Cnt > -1 t hen | |
3988 | begin | |
3989 | for Z := 1 to SubL ineCnt - 1 do | |
3990 | begin | |
3991 | aName := IntToSt r(I) + ',' + IntToSt r(X) + ',' + | |
3992 | IntT oStr(Z); | |
3993 | aValue := Filter edString(L ookUpLst.V alues[aNam e]); | |
3994 | aList. AddSubscri pt([I,X,Z] , aValue); | |
3995 | end; | |
3996 | end | |
3997 | else | |
3998 | begin | |
3999 | aName := IntToStr( I) + ',' + IntToStr( X); | |
4000 | aValue : = Filtered String(Loo kUpLst.Val ues[aName] ); | |
4001 | aList.Ad dSubscript ([I,X], aV alue); | |
4002 | end; | |
4003 | en d; | |
4004 | end; | |
4005 | ||
4006 | Call VistA('ORW TIU SVCOPY ', [aList, DivisionI D], Return List); | |
4007 | finall y | |
4008 | Look UpLst.Free ; | |
4009 | end; | |
4010 | end; | |
4011 | end; | |
4012 | ||
4013 | procedure TfrmFrame. StartPollB uff(Sender : TObject; var Error : Boolean) ; | |
4014 | Var | |
4015 | DivID, IP Addr, TmpR tn: string ; | |
4016 | begin | |
4017 | inherite d; | |
4018 | DivID := GetDivisi onID; | |
4019 | IPAddr : = DottedIP Str; | |
4020 | CallVist A('ORWTIU START', [ User.DUZ, DivID, IPA ddr, IntTo Hex(frmFra me.Handle, 8)], TmpR tn); | |
4021 | Error := TmpRtn = '0'; | |
4022 | end; | |
4023 | ||
4024 | procedure TfrmFrame. StopPollBu ff(Sender: TObject; var Error: Boolean); | |
4025 | Var | |
4026 | IPAddr, T mpRtn: str ing; | |
4027 | begin | |
4028 | inherite d; | |
4029 | IPAddr : = DottedIP Str; | |
4030 | CallVist A('ORWTIU STOP', [Us er.DUZ, IP Addr, IntT oHex(frmFr ame.Handle , 8)], Tmp Rtn); | |
4031 | Error := TmpRtn = '0'; | |
4032 | end; | |
4033 | ||
4034 | procedure TfrmFrame. CreateTab( ATabID: in teger; ALa bel: strin g); | |
4035 | begin | |
4036 | // old comment - try making owner sel f (instead of applic ation) to see if sol ves TMenuI tem.Insert bug | |
4037 | case ATa bID of | |
4038 | CT_PRO BLEMS : be gin | |
4039 | frmProblem s := TfrmP roblems.Cr eate(Self) ; | |
4040 | frmProblem s.Parent : = pnlPage; | |
4041 | en d; | |
4042 | CT_MED S : be gin | |
4043 | frmMeds := TfrmMeds. Create(Sel f); | |
4044 | frmMeds.Pa rent := pn lPage; | |
4045 | frmMeds.In itfMedsSiz e; | |
4046 | en d; | |
4047 | CT_ORD ERS : be gin | |
4048 | frmOrders := TfrmOrd ers.Create (Self); | |
4049 | frmOrders. Parent := pnlPage; | |
4050 | en d; | |
4051 | CT_HP : be gin | |
4052 | // not yet | |
4053 | en d; | |
4054 | CT_NOT ES : be gin | |
4055 | frmNotes : = TfrmNote s.Create(S elf); | |
4056 | frmNotes.P arent := p nlPage; | |
4057 | en d; | |
4058 | CT_CON SULTS : be gin | |
4059 | frmConsult s := TfrmC onsults.Cr eate(Self) ; | |
4060 | frmConsult s.Parent : = pnlPage; | |
4061 | en d; | |
4062 | CT_DCS UMM : be gin | |
4063 | frmDCSumm := TfrmDCS umm.Create (Self); | |
4064 | frmDCSumm. Parent := pnlPage; | |
4065 | en d; | |
4066 | CT_LAB S : be gin | |
4067 | frmLabs := TfrmLabs. Create(Sel f); | |
4068 | frmLabs.Pa rent := pn lPage; | |
4069 | en d; | |
4070 | CT_REP ORTS : be gin | |
4071 | frmReports := TfrmRe ports.Crea te(Self); | |
4072 | frmReports .Parent := pnlPage; | |
4073 | en d; | |
4074 | CT_SUR GERY : be gin | |
4075 | frmSurgery := TfrmSu rgery.Crea te(Self); | |
4076 | frmSurgery .Parent := pnlPage; | |
4077 | en d; | |
4078 | CT_COV ER : be gin | |
4079 | frmCoverSh eet := Tfr mCoverShee t.Create(S elf); | |
4080 | frmCoverSh eet.Parent := pnlPag e; | |
4081 | CoverSheet .OnRefresh CWAD := Re freshCWAD; | |
4082 | CoverSheet .OnRefresh Reminders := Reminde rsChanged; | |
4083 | en d; | |
4084 | else | |
4085 | Exit; | |
4086 | end; | |
4087 | if ATabI D = CT_COV ER then | |
4088 | begin | |
4089 | uTab List.Inser t(0, IntTo Str(ATabID )); | |
4090 | tabP age.Tabs.I nsert(0, A Label); | |
4091 | tabP age.TabInd ex := 0; | |
4092 | end | |
4093 | else | |
4094 | begin | |
4095 | uTab List.Add(I ntToStr(AT abID)); | |
4096 | tabP age.Tabs.A dd(ALabel) ; | |
4097 | end; | |
4098 | end; | |
4099 | ||
4100 | procedure TfrmFrame. ShowHideCh artTabMenu s(AMenuIte m: TMenuIt em); | |
4101 | var | |
4102 | i: integ er; | |
4103 | begin | |
4104 | for i := 0 to AMen uItem.Coun t - 1 do | |
4105 | AMenuI tem.Items[ i].Visible := TabExi sts(AMenuI tem.Items[ i].Tag); | |
4106 | end; | |
4107 | ||
4108 | function T frmFrame.T abExists(A TabID: int eger): boo lean; | |
4109 | begin | |
4110 | Result : = (uTabLis t.IndexOf( IntToStr(A TabID)) > -1) | |
4111 | end; | |
4112 | ||
4113 | procedure TfrmFrame. ReportsOnl yDisplay; | |
4114 | begin | |
4115 | ||
4116 | // Configu re "Edit" menu: | |
4117 | menuHideAl lBut(mnuEd it, mnuEdi tPref); // Hide everything under Edi t menu exc ept Prefer ences. | |
4118 | menuHideAl lBut(mnuEd itPref, Pr efs1); // Hide every thing unde r Preferen ces menu e xcept Font s. | |
4119 | ||
4120 | // Remaini ng pull-do wn menus: | |
4121 | mnuView.vi sible := f alse; | |
4122 | mnuFileRef resh.visib le := fals e; | |
4123 | mnuFileEnc ounter.vis ible := fa lse; | |
4124 | mnuFileRev iew.visibl e := false ; | |
4125 | mnuFileNex t.visible := false; | |
4126 | mnuFileNot ifRemove.v isible := false; | |
4127 | mnuHelpBro ker.visibl e := false ; | |
4128 | mnuHelpLis ts.visible := false; | |
4129 | mnuHelpSym bols.visib le := fals e; | |
4130 | ||
4131 | // Top pan el compone nts: | |
4132 | pnlVisit.h int := 'Pr ovider/Loc ation'; | |
4133 | pnlVisit.o nMouseDown := nil; | |
4134 | pnlVisit.o nMouseUp : = nil; | |
4135 | ||
4136 | // Forms f or other t abs: | |
4137 | frmCoverSh eet.visibl e := false ; | |
4138 | frmProblem s.visible := false; | |
4139 | frmMeds.vi sible := f alse; | |
4140 | frmOrders. visible := false; | |
4141 | frmNotes.v isible := false; | |
4142 | frmConsult s.visible := false; | |
4143 | frmDCSumm. visible := false; | |
4144 | if Assigne d(frmSurge ry) then | |
4145 | frmSurge ry.visible := false; | |
4146 | frmLabs.vi sible := f alse; | |
4147 | ||
4148 | // Other t abs (so to speak): | |
4149 | tabPage.ta bs.clear; | |
4150 | tabPage.ta bs.add('Re ports'); | |
4151 | ||
4152 | end; | |
4153 | ||
4154 | procedure TfrmFrame. UpdatePtIn foOnRefres h; | |
4155 | var | |
4156 | tmpDFN: string; | |
4157 | begin | |
4158 | tmpDFN : = Patient. DFN; | |
4159 | Patient. Clear; | |
4160 | Patient. DFN := tmp DFN; | |
4161 | uCore.Te mpEncounte rLoc := 0; //hds759 1 Clinic/ Ward movem ent. | |
4162 | uCore.Te mpEncounte rLocName : = ''; //hd s7591 Cli nic/Ward m ovement. | |
4163 | uCore.Te mpEncounte rText := ' '; | |
4164 | uCore.Te mpEncounte rDateTime := 0; | |
4165 | uCore.Te mpEncounte rVistCat : = #0; | |
4166 | if (not FRefreshin g) and (FR eviewClick = false) then DoNot ChangeEncW indow := f alse; | |
4167 | if (FPre vInPatient and Patie nt.Inpatie nt) then //tran sfering in side hospi tal | |
4168 | begin | |
4169 | if FReview Click = Tr ue then | |
4170 | begin | |
4171 | ucore. TempEncoun terLoc := Encounter. Location; | |
4172 | uCore. TempEncoun terLocName := Encoun ter.Locati onName; | |
4173 | uCore. TempEncoun terText := Encounter .LocationT ext; | |
4174 | uCore. TempEncoun terDateTim e := Encou nter.DateT ime; | |
4175 | uCore. TempEncoun terVistCat := Encoun ter.VisitC ategory; | |
4176 | end | |
4177 | else if (p atient.Loc ation <> e ncounter.L ocation) a nd (OrderP rintForm = false) th en | |
4178 | begi n | |
4179 | fr mPrintLoca tion.Switc hEncounter Loction(En counter.Lo cation, En counter.lo cationName , Encounte r.Location Text, | |
4180 | En counter.Da teTime, En counter.Vi sitCategor y); | |
4181 | Di splayEncou nterText; | |
4182 | ex it; | |
4183 | end | |
4184 | else if (p atient.Loc ation <> e ncounter.L ocation) a nd (OrderP rintForm = True) the n | |
4185 | begin | |
4186 | OrderP rintForm : = false; | |
4187 | Exit; | |
4188 | end; | |
4189 | if orderpr intform = false then Encounter .Location := Patient .Location; | |
4190 | end | |
4191 | else if (FPrevInPa tient and (not Patie nt.Inpatie nt)) then //pati ent was di scharged | |
4192 | begin | |
4193 | Encoun ter.Inpati ent := Fal se; | |
4194 | Encoun ter.Locati on := 0; | |
4195 | FPrevI nPatient : = False; | |
4196 | lblPtN ame.Captio n := ''; | |
4197 | lblPtN ame.Captio n := Patie nt.Name + Patient.St atus; //CQ #17491: R efresh pat ient statu s indicato r in heade r bar on d ischarge. | |
4198 | end | |
4199 | else if ((not FPre vInPatient ) and Pati ent.Inpati ent) then //pati ent was ad mitted | |
4200 | begin | |
4201 | Encoun ter.Inpati ent := Tru e; | |
4202 | uCore. TempEncoun terLoc := Encounter. Location; //hds7591 Clinic/W ard moveme nt. | |
4203 | uCore. TempEncoun terLocName := Encoun ter.Locati onName; // hds7591 C linic/Ward movement. | |
4204 | uCore. TempEncoun terText := Encounter .LocationT ext; | |
4205 | uCore. TempEncoun terDateTim e := Encou nter.DateT ime; | |
4206 | uCore. TempEncoun terVistCat := Encoun ter.VisitC ategory; | |
4207 | lblPtN ame.Captio n := ''; | |
4208 | lblPtN ame.Captio n := Patie nt.Name + Patient.St atus; //CQ #17491: R efresh pat ient statu s indicato r in heade r bar on a dmission. | |
4209 | if (FR eviewClick = False) and (encou nter.Locat ion <> pat ient.Locat ion) and ( OrderPrint Form = fal se) then | |
4210 | be gin | |
4211 | frmPrintLo cation.Swi tchEncount erLoction( Encounter. Location, Encounter. locationNa me, Encoun ter.Locati onText, | |
4212 | En counter.Da teTime, En counter.Vi sitCategor y); | |
4213 | //agp valu es are res et dependi ng on the user proce ss | |
4214 | uCore.Temp EncounterL oc := 0; //hds7591 Clinic/Wa rd movemen t. | |
4215 | uCore.Temp EncounterL ocName := ''; //hds7 591 Clini c/Ward mov ement. | |
4216 | uCore.Temp EncounterT ext := ''; | |
4217 | uCore.Temp EncounterD ateTime := 0; | |
4218 | uCore.Temp EncounterV istCat := #0; | |
4219 | en d | |
4220 | else | |
4221 | if Ord erPrintFor m = false then | |
4222 | begi n | |
4223 | En counter.Lo cation := Patient.Lo cation; | |
4224 | En counter.Da teTime := Patient.Ad mitTime; | |
4225 | En counter.Vi sitCategor y := 'H'; | |
4226 | end; | |
4227 | FPrevI nPatient : = True; | |
4228 | end; | |
4229 | DisplayE ncounterTe xt; | |
4230 | end; | |
4231 | ||
4232 | procedure TfrmFrame. UpdateVAAM HVButtons( Sender: TO bject); | |
4233 | begin | |
4234 | Patient. RefreshVAA Status; | |
4235 | Patient. RefreshMHV Status; | |
4236 | ||
4237 | if Patie nt.PtIsVAA then | |
4238 | laVAA2 .Hint := ' Patient ha s active i nsurance' | |
4239 | else | |
4240 | laVAA2 .Hint := ' No active insurance' ; | |
4241 | ||
4242 | if Patie nt.PtIsMHV then | |
4243 | laMHV. Hint := 'P atient has data in M y HealtheV et' | |
4244 | else | |
4245 | laMHV. Hint := 'N o MyHealth yVet data' ; | |
4246 | ||
4247 | laMHV.Al ign := alT op; | |
4248 | laMHV.He ight := pa VAA.Client Height div 2; | |
4249 | laVAA2.A lign := al Client; | |
4250 | ||
4251 | laMHV.En abled := P atient.PtI sMHV; | |
4252 | laVAA2.E nabled := Patient.Pt IsVAA; | |
4253 | ||
4254 | paVAA.Vi sible := ( Patient.Pt IsVAA or P atient.PtI sMHV); | |
4255 | end; | |
4256 | ||
4257 | procedure TfrmFrame. FormKeyDow n(Sender: TObject; v ar Key: Wo rd; Shift: TShiftSta te); | |
4258 | var | |
4259 | NewTabIn dex: integ er; | |
4260 | begin | |
4261 | inherite d; | |
4262 | FCtrlTab Used := FA LSE; | |
4263 | //CQ2844 : Toggle R emote Data button us ing Alt+R | |
4264 | case Ke y of | |
4265 | 82,11 4: if (ss Alt in Shi ft) then | |
4266 | frm Frame.pnlC IRNClick(S ender); | |
4267 | end; | |
4268 | ||
4269 | if (Key = VK_TAB) then | |
4270 | begin | |
4271 | if (ss Ctrl in Sh ift) then | |
4272 | begin | |
4273 | FCtr lTabUsed : = TRUE; | |
4274 | if n ot (Active Control is TCustomMe mo) or not TMemo(Act iveControl ).WantTabs then begi n | |
4275 | Ne wTabIndex := tabPage .TabIndex; | |
4276 | if ssShift i n Shift th en | |
4277 | dec(NewTab Index) | |
4278 | el se | |
4279 | inc(NewTab Index); | |
4280 | if NewTabInd ex >= tabP age.Tabs.C ount then | |
4281 | dec(NewTab Index,tabP age.Tabs.C ount) | |
4282 | el se if NewT abIndex < 0 then | |
4283 | inc(NewTab Index,tabP age.Tabs.C ount); | |
4284 | ta bPage.TabI ndex := Ne wTabIndex; | |
4285 | ta bPageChang e(tabPage) ; | |
4286 | Ke y := 0; | |
4287 | end; | |
4288 | end; | |
4289 | end; | |
4290 | end; | |
4291 | ||
4292 | procedure TfrmFrame. FormActiva te(Sender: TObject); | |
4293 | var | |
4294 | aCPRS508 : ICPRS508 ; | |
4295 | begin | |
4296 | if Assig ned(FLastP age) then | |
4297 | if FLa stPage.Inh eritsFrom( TfrmPage) then | |
4298 | Tfrm Page(FLast Page).Focu sFirstCont rol | |
4299 | else i f Supports (fLastPage , ICPRS508 , aCPRS508 ) then | |
4300 | aCPR S508.OnFoc usFirstCon trol(Sende r);; | |
4301 | end; | |
4302 | ||
4303 | procedure TfrmFrame. pnlPrimary CareEnter( Sender: TO bject); | |
4304 | begin | |
4305 | with Sen der as TPa nel do | |
4306 | if (Co ntrolCount > 0) and (Controls[ 0] is TSpe edButton) and (TSpee dButton(Co ntrols[0]) .Down) | |
4307 | then | |
4308 | Beve lInner := bvLowered | |
4309 | else | |
4310 | Beve lInner := bvRaised; | |
4311 | end; | |
4312 | ||
4313 | procedure TfrmFrame. pnlPrimary CareExit(S ender: TOb ject); | |
4314 | var | |
4315 | ShiftIsD own,TabIsD own : bool ean; | |
4316 | begin | |
4317 | with Sen der as TPa nel do beg in | |
4318 | BevelI nner := bv None; | |
4319 | //Make the lstCI RNLocation s act as i f between pnlCIRN & pnlReminde rs | |
4320 | //in t he Tab Ord er | |
4321 | if (ls tCIRNLocat ions.CanFo cus) then | |
4322 | begin | |
4323 | Shif tIsDown := Boolean(H i(GetKeySt ate(VK_SHI FT))); | |
4324 | TabI sDown := B oolean(Hi( GetKeyStat e(VK_TAB)) ); | |
4325 | if T abIsDown t hen | |
4326 | if (ShiftIsD own) and ( Name = 'pn lReminders ') then | |
4327 | lstCIRNLoc ations.Set Focus | |
4328 | el se if Not (ShiftIsDo wn) and (N ame = 'pnl CIRN') the n | |
4329 | lstCIRNLoc ations.Set Focus; | |
4330 | end; | |
4331 | end; | |
4332 | end; | |
4333 | ||
4334 | procedure TfrmFrame. pnlPatient Click(Send er: TObjec t); | |
4335 | begin | |
4336 | Screen.C ursor := c rHourglass ; //wat cq 18425 add ed hourgla ss and dis abled mnuF ileOpen | |
4337 | mnuFileO pen.Enable d := False ; | |
4338 | try | |
4339 | pnlPatie nt.Enabled := false; | |
4340 | ViewInfo (mnuViewDe mo); | |
4341 | pnlPatie nt.Enabled := true; | |
4342 | finally | |
4343 | Screen .Cursor := crDefault ; | |
4344 | mnuFil eOpen.Enab led := Tru e; | |
4345 | end; | |
4346 | end; | |
4347 | ||
4348 | procedure TfrmFrame. pnlVisitCl ick(Sender : TObject) ; | |
4349 | begin | |
4350 | ViewInfo (mnuViewVi sits); | |
4351 | end; | |
4352 | ||
4353 | procedure TfrmFrame. pnlPrimary CareClick( Sender: TO bject); | |
4354 | begin | |
4355 | ViewInfo (mnuViewPr imaryCare) ; | |
4356 | end; | |
4357 | ||
4358 | procedure TfrmFrame. pnlReminde rsClick(Se nder: TObj ect); | |
4359 | begin | |
4360 | if(pnlRe minders.ta g = HAVE_R EMINDERS) then | |
4361 | View Info(mnuVi ewReminder s); | |
4362 | ||
4363 | end; | |
4364 | ||
4365 | procedure TfrmFrame. pnlPosting sClick(Sen der: TObje ct); | |
4366 | begin | |
4367 | ViewInfo (mnuViewPo stings); | |
4368 | end; | |
4369 | ||
4370 | //======== ========== ========= CCOW main changes == ========== ========== == | |
4371 | ||
4372 | procedure TfrmFrame. HandleCCOW Error(AMes sage: stri ng); | |
4373 | begin | |
4374 | {$ifdef DEBUG} | |
4375 | Show50 8Message(A Message); | |
4376 | {$endif} | |
4377 | InfoBox( TX_CCOW_ER ROR, TC_CC OW_ERROR, MB_ICONERR OR or MB_O K); | |
4378 | FCCOWIns talled := False; | |
4379 | imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, 'BM P_CCOW_BRO KEN'); | |
4380 | pnlCCOW. Hint := TX _CCOW_BROK EN; | |
4381 | mnuFileR esumeConte xt.Visible := True; | |
4382 | mnuFileR esumeConte xt.Enabled := False; | |
4383 | mnuFileB reakContex t.Visible := True; | |
4384 | mnuFileB reakContex t.Enabled := False; | |
4385 | FCCOWErr or := True ; | |
4386 | end; | |
4387 | ||
4388 | function T frmFrame.A llowCCOWCo ntextChang e(var CCOW Response: UserRespon se; NewDFN : string): boolean; | |
4389 | var | |
4390 | PtData : IContextI temCollect ion; | |
4391 | PtDataIt em2, PtDat aItem3, Pt DataItem4 : IContext Item; | |
4392 | response : UserRes ponse; | |
4393 | StationN umber: str ing; | |
4394 | IsProdAc ct: boolea n; | |
4395 | begin | |
4396 | Result : = False; | |
4397 | response := 0; | |
4398 | try | |
4399 | // Sta rt a conte xt change transactio n | |
4400 | if FCC OWInstalle d then | |
4401 | beg in | |
4402 | FCCOWJustJ oined := F alse; | |
4403 | FCCOWError := False; | |
4404 | imgCCOW.Pi cture.BitM ap.LoadFro mResourceN ame(hInsta nce, 'BMP_ CCOW_CHANG ING'); | |
4405 | pnlCCOW.Hi nt := TX_C COW_CHANGI NG; | |
4406 | try | |
4407 | ctxConte xtor.Start ContextCha nge(); | |
4408 | except | |
4409 | on E: Ex ception do HandleCCO WError(E.M essage); | |
4410 | end; | |
4411 | if FCCOWEr ror then | |
4412 | begin | |
4413 | Result : = False; | |
4414 | Exit; | |
4415 | end; | |
4416 | // Set the new propo sed contex t data. | |
4417 | PtData := CoContextI temCollect ion.Create (); | |
4418 | StationNum ber := Use r.StationN umber; | |
4419 | IsProdAcct := User.I sProductio nAccount; | |
4420 | ||
4421 | {$IFDEF CC OWBROKER} | |
4422 | //IsProdAc ct := RPCB rokerV.Log in.IsProdu ction; // not yet | |
4423 | {$ENDIF} | |
4424 | ||
4425 | PtDataItem 2 := CoCon textItem.C reate(); | |
4426 | PtDataItem 2.Set_Name ('Patient. co.Patient Name'); // Pati ent.Name | |
4427 | PtDataItem 2.Set_Valu e(Piece(Pa tient.Name , ',', 1) + U + Piec e(Patient. Name, ',', 2) + '^^^ ^'); | |
4428 | PtData.Add (PtDataIte m2); | |
4429 | ||
4430 | PtDataItem 3 := CoCon textItem.C reate(); | |
4431 | if not IsP rodAcct th en | |
4432 | PtDataIt em3.Set_Na me('Patien t.id.MRN.D FN_' + Sta tionNumber + '_TEST' ) // Pa tient.DFN | |
4433 | else | |
4434 | PtDataIt em3.Set_Na me('Patien t.id.MRN.D FN_' + Sta tionNumber ); // Pa tient.DFN | |
4435 | PtDataItem 3.Set_Valu e(Patient. DFN); | |
4436 | PtData.Add (PtDataIte m3); | |
4437 | ||
4438 | if Patient .ICN <> '' then | |
4439 | begin | |
4440 | PtData Item4 := C oContextIt em.Create( ); | |
4441 | if not IsProdAcc t then | |
4442 | PtDa taItem4.Se t_Name('Pa tient.id.M RN.Nationa lIDNumber_ TEST') / / Patient. ICN | |
4443 | else | |
4444 | PtDa taItem4.Se t_Name('Pa tient.id.M RN.Nationa lIDNumber' ); / / Patient. ICN | |
4445 | PtData Item4.Set_ Value(Pati ent.ICN); | |
4446 | PtData .Add(PtDat aItem4); | |
4447 | end; | |
4448 | ||
4449 | // End the context c hange tran saction. | |
4450 | FCCOWError := False; | |
4451 | try | |
4452 | response := ctxCon textor.End ContextCha nge(true, PtData); | |
4453 | except | |
4454 | on E: Ex ception do HandleCCO WError(E.M essage); | |
4455 | end; | |
4456 | if FCCOWEr ror then | |
4457 | begin | |
4458 | HideEver ything; | |
4459 | Result : = False; | |
4460 | Exit; | |
4461 | end; | |
4462 | end | |
4463 | else | |
4464 | begi n | |
4465 | Re sult := Tr ue; | |
4466 | Ex it; | |
4467 | end; | |
4468 | ||
4469 | CCOWRe sponse := response; | |
4470 | if (re sponse = U rCommit) t hen | |
4471 | begin | |
4472 | // N ew context is commit ted. | |
4473 | mnuF ileResumeC ontext.Ena bled := Fa lse; | |
4474 | mnuF ileBreakCo ntext.Enab led := Tru e; | |
4475 | FCCO WIconName := 'BMP_CC OW_LINKED' ; | |
4476 | pnlC COW.Hint : = TX_CCOW_ LINKED; | |
4477 | imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance, FCCOWIcon Name); | |
4478 | Resu lt := True ; | |
4479 | end | |
4480 | else i f (respons e = UrCanc el) then | |
4481 | begin | |
4482 | // P roposed co ntext chan ge is canc eled. Retu rn to the current co ntext. | |
4483 | PtDa ta.RemoveA ll; | |
4484 | mnuF ileResumeC ontext.Ena bled := Fa lse; | |
4485 | mnuF ileBreakCo ntext.Enab led := Tru e; | |
4486 | imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance, FCCOWIcon Name); | |
4487 | Resu lt := Fals e; | |
4488 | end | |
4489 | else i f (respons e = UrBrea k) then | |
4490 | begin | |
4491 | // T he context or has bro ken the li nk by susp ending. T his app sh ould | |
4492 | // u pdate the Clinical L ink icon, enable the Resume me nu item, a nd | |
4493 | // d isable the Suspend m enu item. | |
4494 | PtDa ta.RemoveA ll; | |
4495 | mnuF ileResumeC ontext.Ena bled := Tr ue; | |
4496 | mnuF ileBreakCo ntext.Enab led := Fal se; | |
4497 | FCCO WIconName := 'BMP_CC OW_BROKEN' ; | |
4498 | pnlC COW.Hint : = TX_CCOW_ BROKEN; | |
4499 | imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance, FCCOWIcon Name); | |
4500 | if P atient.Inp atient the n | |
4501 | begi n | |
4502 | En counter.In patient := True; | |
4503 | En counter.Lo cation := Patient.Lo cation; | |
4504 | En counter.Da teTime := Patient.Ad mitTime; | |
4505 | En counter.Vi sitCategor y := 'H'; | |
4506 | end; | |
4507 | if U ser.IsProv ider then Encounter. Provider : = User.DUZ ; | |
4508 | Setu pPatient; | |
4509 | tabP age.TabInd ex := Page IDToTab(Us er.Initial Tab); | |
4510 | tabP ageChange( tabPage); | |
4511 | Resu lt := Fals e; | |
4512 | end; | |
4513 | except | |
4514 | on exc : EOleExc eption do | |
4515 | Show Msg('EOleE xception: ' + exc.Me ssage); | |
4516 | end; | |
4517 | end; | |
4518 | ||
4519 | procedure TfrmFrame. ctxContext orCanceled (Sender: T Object); | |
4520 | begin | |
4521 | // Appli cation sho uld mainta in its sta te as the current (e xisting) c ontext. | |
4522 | imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName ); | |
4523 | end; | |
4524 | ||
4525 | procedure TfrmFrame. ctxContext orPending( Sender: TO bject; | |
4526 | const aC ontextItem Collection : IDispatc h); | |
4527 | var | |
4528 | Reason, HyperLinkR eason: str ing; | |
4529 | PtChange d: boolean ; | |
4530 | {$IFDEF CC OWBROKER} | |
4531 | UserChan ged: boole an; | |
4532 | {$ENDIF} | |
4533 | begin | |
4534 | // If th e app woul d lose dat a, or have other pro blems chan ging conte xt at | |
4535 | // this time, it s hould retu rn a messa ge using S etSurveyRe ponse. Not e that the | |
4536 | // user may decide to commit the conte xt change anyway. | |
4537 | // | |
4538 | // if (c annot-chan ge-context -without-a -problem) then | |
4539 | // con textor.Set SurveyResp onse('Cond itional ac cept reaso n...'); | |
4540 | if FCCOW Busy then | |
4541 | begin | |
4542 | Sleep( 10000); | |
4543 | end; | |
4544 | ||
4545 | FCCOWErr or := Fals e; | |
4546 | try | |
4547 | CheckF orDifferen tPatient(a ContextIte mCollectio n, PtChang ed); | |
4548 | {$IFDEF CC OWBROKER} | |
4549 | CheckF orDifferen tUser(aCon textItemCo llection, UserChange d); | |
4550 | {$ENDIF} | |
4551 | except | |
4552 | on E: Exception do HandleC COWError(E .Message); | |
4553 | end; | |
4554 | if FCCOW Error then | |
4555 | begin | |
4556 | HideEv erything; | |
4557 | Exit; | |
4558 | end; | |
4559 | ||
4560 | {$IFDEF CC OWBROKER} | |
4561 | if PtCha nged or Us erChanged then | |
4562 | {$ELSE} | |
4563 | if PtCha nged then | |
4564 | {$ENDIF} | |
4565 | begin | |
4566 | FCCO WContextCh anging := True; | |
4567 | imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance, 'BMP_CCOW _CHANGING' ); | |
4568 | pnlC COW.Hint : = TX_CCOW_ CHANGING; | |
4569 | Allo wContextCh angeAll(Re ason); | |
4570 | end; | |
4571 | CheckHyp erlinkResp onse(aCont extItemCol lection, H yperlinkRe ason); | |
4572 | Reason : = Hyperlin kReason + Reason; | |
4573 | if Pos(' COM_OBJECT _ACTIVE', Reason) > 0 then | |
4574 | Sleep( 12000) | |
4575 | else if Length(Rea son) > 0 t hen | |
4576 | ctxCon textor.Set SurveyResp onse(Reaso n) | |
4577 | else | |
4578 | begin | |
4579 | imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance, 'BMP_CCOW _LINKED'); | |
4580 | pnlC COW.Hint : = TX_CCOW_ LINKED; | |
4581 | end; | |
4582 | FCCOWCon textChangi ng := Fals e; | |
4583 | end; | |
4584 | ||
4585 | procedure TfrmFrame. ctxContext orCommitte d(Sender: TObject); | |
4586 | var | |
4587 | Reason: string; | |
4588 | PtChange d: boolean ; | |
4589 | i: integ er; | |
4590 | begin | |
4591 | // Appli cation sho uld now ac cess the n ew context and updat e its stat e. | |
4592 | FCCOWErr or := Fals e; | |
4593 | try | |
4594 | {$IFDEF CCOWBROKER } | |
4595 | with R PCBrokerV do if (Was UserDefine d and IsUs erCleared and (ctxCo ntextor.Cu rrentConte xt.Present (CCOW_USER _NAME) = n il)) then // RV 0 5/11/04 | |
4596 | begin | |
4597 | Reas on := 'COM MIT'; | |
4598 | if A llowContex tChangeAll (Reason) t hen | |
4599 | begi n | |
4600 | Cl ose; | |
4601 | Ex it; | |
4602 | end; | |
4603 | end; | |
4604 | {$ENDIF} | |
4605 | CheckF orDifferen tPatient(c txContexto r.CurrentC ontext, Pt Changed); | |
4606 | except | |
4607 | on E: Exception do HandleC COWError(E .Message); | |
4608 | end; | |
4609 | if FCCOW Error then | |
4610 | begin | |
4611 | HideEv erything; | |
4612 | Exit; | |
4613 | end; | |
4614 | if not P tChanged t hen exit; | |
4615 | FCCOWDri vedChange := True; | |
4616 | i := 0; | |
4617 | while Le ngth(Scree n.Forms[i] .Name) > 0 do | |
4618 | begin | |
4619 | if fsM odal in Sc reen.Forms [i].FormSt ate then | |
4620 | begin | |
4621 | Scre en.Forms[i ].ModalRes ult := mrC ancel; | |
4622 | i := i + 1; | |
4623 | end el se // the fsModal f orms alway s sequence d prior to the none- fsModal fo rms | |
4624 | Brea k; | |
4625 | end; | |
4626 | Reason : = 'COMMIT' ; | |
4627 | if Allow ContextCha ngeAll(Rea son) then UpdateCCOW Context; | |
4628 | FCCOWIco nName := ' BMP_CCOW_L INKED'; | |
4629 | pnlCCOW. Hint := TX _CCOW_LINK ED; | |
4630 | imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName ); | |
4631 | end; | |
4632 | ||
4633 | function T frmFrame.F indBestCCO WDFN: stri ng; | |
4634 | var | |
4635 | data: IC ontextItem Collection ; | |
4636 | anItem: IContextIt em; | |
4637 | StationN umber, tem pDFN: stri ng; | |
4638 | IsProdAc ct: Boole an; | |
4639 | ||
4640 | procedur e FindNext BestDFN; | |
4641 | begin | |
4642 | Statio nNumber := User.Stat ionNumber; | |
4643 | if IsP rodAcct th en | |
4644 | anIt em := data .Present(' Patient.id .MRN.DFN_' + Station Number) | |
4645 | else | |
4646 | anIt em := data .Present(' Patient.id .MRN.DFN_' + Station Number + ' _TEST'); | |
4647 | if anI tem <> ni l then tem pDFN := an Item.Get_V alue(); | |
4648 | end; | |
4649 | ||
4650 | begin | |
4651 | if uCore .User = ni l then | |
4652 | begin | |
4653 | Result := ''; | |
4654 | exit; | |
4655 | end; | |
4656 | IsProdAc ct := User .IsProduct ionAccount ; | |
4657 | // Get a n item col lection of the curre nt context | |
4658 | FCCOWErr or := Fals e; | |
4659 | try | |
4660 | data : = ctxConte xtor.Curre ntContext; | |
4661 | except | |
4662 | on E: Exception do HandleC COWError(E .Message); | |
4663 | end; | |
4664 | if FCCOW Error then | |
4665 | begin | |
4666 | HideEv erything; | |
4667 | Exit; | |
4668 | end; | |
4669 | // Retri eve the Co ntextItem name and v alue as st rings | |
4670 | if IsPro dAcct then | |
4671 | anItem := data.P resent('Pa tient.id.M RN.Nationa lIDNumber' ) | |
4672 | else | |
4673 | anItem := data.P resent('Pa tient.id.M RN.Nationa lIDNumber_ TEST'); | |
4674 | if anIte m <> nil t hen | |
4675 | begin | |
4676 | temp DFN := Get DFNFromICN (anItem.Ge t_Value()) ; // "Pub lic" RPC c all | |
4677 | if t empDFN = ' -1' then F indNextBes tDFN; | |
4678 | end | |
4679 | else | |
4680 | FindNe xtBestDFN; | |
4681 | Result : = tempDFN; | |
4682 | data := nil; | |
4683 | anItem : = nil; | |
4684 | end; | |
4685 | ||
4686 | procedure TfrmFrame. UpdateCCOW Context; | |
4687 | var | |
4688 | PtDFN(*, PtName*): string; | |
4689 | begin | |
4690 | if not F CCOWInstal led then e xit; | |
4691 | DoNotCha ngeEncWind ow := fals e; | |
4692 | PtDFN := FindBestC COWDFN; | |
4693 | if StrTo Int64Def(P tDFN, 0) > 0 then | |
4694 | begin | |
4695 | // S elect new patient ba sed on con text value | |
4696 | if P atient.DFN = PtDFN t hen exit; | |
4697 | Pati ent.DFN := PtDFN; | |
4698 | if ( Patient.Na me = '-1') then | |
4699 | be gin | |
4700 | HideEveryt hing; | |
4701 | exit; | |
4702 | en d | |
4703 | else | |
4704 | Sh owEverythi ng; | |
4705 | Enco unter.Clea r; | |
4706 | if P atient.Inp atient the n | |
4707 | begi n | |
4708 | En counter.In patient := True; | |
4709 | En counter.Lo cation := Patient.Lo cation; | |
4710 | En counter.Da teTime := Patient.Ad mitTime; | |
4711 | En counter.Vi sitCategor y := 'H'; | |
4712 | end; | |
4713 | if U ser.IsProv ider then Encounter. Provider : = User.DUZ ; | |
4714 | if n ot FFirstL oad then S etupPatien t; | |
4715 | { fr mCover.Upd ateVAAButt on; //VAA} | |
4716 | Upda teVAAMHVBu ttons(nil) ; | |
4717 | Dete rmineNextT ab; | |
4718 | tabP age.TabInd ex := Page IDToTab(Ne xtTab); | |
4719 | tabP ageChange( tabPage); | |
4720 | end | |
4721 | else | |
4722 | HideEv erything; | |
4723 | end; | |
4724 | ||
4725 | procedure TfrmFrame. mnuFileBre akContextC lick(Sende r: TObject ); | |
4726 | begin | |
4727 | FCCOWErr or := Fals e; | |
4728 | FCCOWIco nName := ' BMP_CCOW_C HANGING'; | |
4729 | pnlCCOW. Hint := TX _CCOW_CHAN GING; | |
4730 | imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName ); | |
4731 | try | |
4732 | ctxCon textor.Sus pend; | |
4733 | except | |
4734 | on E: Exception do HandleC COWError(E .Message); | |
4735 | end; | |
4736 | if FCCOW Error then exit; | |
4737 | FCCOWIco nName := ' BMP_CCOW_B ROKEN'; | |
4738 | pnlCCOW. Hint := TX _CCOW_BROK EN; | |
4739 | imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName ); | |
4740 | mnuFileR esumeConte xt.Enabled := True; | |
4741 | mnuFileB reakContex t.Enabled := False; | |
4742 | end; | |
4743 | ||
4744 | procedure TfrmFrame. mnuFileRes umeContext GetClick(S ender: TOb ject); | |
4745 | var | |
4746 | Reason: string; | |
4747 | begin | |
4748 | Reason : = ''; | |
4749 | if not A llowContex tChangeAll (Reason) t hen exit; | |
4750 | FCCOWIco nName := ' BMP_CCOW_C HANGING'; | |
4751 | pnlCCOW. Hint := TX _CCOW_CHAN GING; | |
4752 | imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName ); | |
4753 | FCCOWErr or := Fals e; | |
4754 | try | |
4755 | ctxCon textor.Res ume; | |
4756 | except | |
4757 | on E: Exception do HandleC COWError(E .Message); | |
4758 | end; | |
4759 | if FCCOW Error then exit; | |
4760 | UpdateCC OWContext; | |
4761 | if not F NoPatientS elected th en | |
4762 | begin | |
4763 | FCCOWI conName := 'BMP_CCOW _LINKED'; | |
4764 | pnlCCO W.Hint := TX_CCOW_LI NKED; | |
4765 | imgCCO W.Picture. BitMap.Loa dFromResou rceName(hI nstance, F CCOWIconNa me); | |
4766 | mnuFil eResumeCon text.Enabl ed := Fals e; | |
4767 | mnuFil eBreakCont ext.Visibl e := True; | |
4768 | mnuFil eBreakCont ext.Enable d := True; | |
4769 | end; | |
4770 | end; | |
4771 | ||
4772 | procedure TfrmFrame. mnuFileRes umeContext SetClick(S ender: TOb ject); | |
4773 | var | |
4774 | CCOWResp onse: User Response; | |
4775 | Reason: string; | |
4776 | begin | |
4777 | Reason : = ''; | |
4778 | if not A llowContex tChangeAll (Reason) t hen exit; | |
4779 | FCCOWIco nName := ' BMP_CCOW_C HANGING'; | |
4780 | pnlCCOW. Hint := TX _CCOW_CHAN GING; | |
4781 | imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName ); | |
4782 | FCCOWErr or := Fals e; | |
4783 | try | |
4784 | ctxCon textor.Res ume; | |
4785 | except | |
4786 | on E: Exception do HandleC COWError(E .Message); | |
4787 | end; | |
4788 | if FCCOW Error then exit; | |
4789 | if (Allo wCCOWConte xtChange(C COWRespons e, Patient .DFN)) the n | |
4790 | begin | |
4791 | mnuF ileResumeC ontext.Ena bled := Fa lse; | |
4792 | mnuF ileBreakCo ntext.Visi ble := Tru e; | |
4793 | mnuF ileBreakCo ntext.Enab led := Tru e; | |
4794 | FCCO WIconName := 'BMP_CC OW_LINKED' ; | |
4795 | pnlC COW.Hint : = TX_CCOW_ LINKED; | |
4796 | imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance, FCCOWIcon Name); | |
4797 | end | |
4798 | else | |
4799 | begin | |
4800 | mnuF ileResumeC ontext.Ena bled := Tr ue; | |
4801 | mnuF ileBreakCo ntext.Enab led := Fal se; | |
4802 | FCCO WIconName := 'BMP_CC OW_BROKEN' ; | |
4803 | pnlC COW.Hint : = TX_CCOW_ BROKEN; | |
4804 | imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance, FCCOWIcon Name); | |
4805 | try | |
4806 | if ctxContex tor.State in [csPart icipating] then ctxC ontextor.S uspend; | |
4807 | exce pt | |
4808 | on E: Except ion do Han dleCCOWErr or(E.Messa ge); | |
4809 | end; | |
4810 | end; | |
4811 | SetupPat ient; | |
4812 | tabPage. TabIndex : = PageIDTo Tab(User.I nitialTab) ; | |
4813 | tabPageC hange(tabP age); | |
4814 | end; | |
4815 | ||
4816 | procedure TfrmFrame. CheckForDi fferentPat ient(aCont extItemCol lection: I Dispatch; var PtChan ged: boole an); | |
4817 | var | |
4818 | data : I ContextIte mCollectio n; | |
4819 | anItem: IContextIt em; | |
4820 | PtDFN, P tName: str ing; | |
4821 | begin | |
4822 | if uCore .Patient = nil then | |
4823 | begin | |
4824 | PtChan ged := Fal se; | |
4825 | Exit; | |
4826 | end; | |
4827 | data := IContextIt emCollecti on(aContex tItemColle ction) ; | |
4828 | PtDFN := FindBestC COWDFN; | |
4829 | // Retri eve the Co ntextItem name and v alue as st rings | |
4830 | anItem : = data.Pre sent('Pati ent.co.Pat ientName') ; | |
4831 | if anIte m <> nil t hen PtName := anItem .Get_Value (); | |
4832 | PtChange d := not ( (PtDFN = P atient.DFN ) and (PtN ame = Piec e(Patient. Name, ',', 1) + U + Piece(Pati ent.Name, ',', 2) + '^^^^')); | |
4833 | end; | |
4834 | ||
4835 | {$IFDEF CC OWBROKER} | |
4836 | procedure TfrmFrame. CheckForDi fferentUse r(aContext ItemCollec tion: IDis patch; var UserChang ed: boolea n); | |
4837 | var | |
4838 | data : I ContextIte mCollectio n; | |
4839 | begin | |
4840 | if uCore .User = ni l then | |
4841 | begin | |
4842 | UserCh anged := F alse; | |
4843 | Exit; | |
4844 | end; | |
4845 | data := IContextIt emCollecti on(aContex tItemColle ction) ; | |
4846 | UserChan ged := RPC BrokerV.Is UserContex tPending(d ata); | |
4847 | end; | |
4848 | {$ENDIF} | |
4849 | ||
4850 | procedure TfrmFrame. CheckHyper linkRespon se(aContex tItemColle ction: IDi spatch; va r Hyperlin kReason: s tring); | |
4851 | var | |
4852 | data : I ContextIte mCollectio n; | |
4853 | anItem : IContextI tem; | |
4854 | itemvalu e: string; | |
4855 | PtSubjec t: string; | |
4856 | begin | |
4857 | data := IContextIt emCollecti on(aContex tItemColle ction) ; | |
4858 | anItem := data.Prese nt('[hds_m ed_ DOMAIN . EXT ]request.i d.name'); | |
4859 | // Retri eve the Co ntextItem name and v alue as st rings | |
4860 | if anIte m <> nil t hen | |
4861 | begin | |
4862 | item Value := a nItem.Get_ Value(); | |
4863 | if i temValue = 'GetWindo wHandle' t hen | |
4864 | be gin | |
4865 | PtSubject := 'patien t.id.mrn.d fn_' + Use r.StationN umber; | |
4866 | if not Use r.IsProduc tionAccoun t then PtS ubject := PtSubject + '_test'; | |
4867 | if data.Pr esent(PtSu bject) <> nil then | |
4868 | Hyperlin kReason := '!@#$' + IntToStr(S elf.Handle ) + ':0:' | |
4869 | else | |
4870 | Hyperlin kReason := ''; | |
4871 | en d; | |
4872 | end; | |
4873 | end; | |
4874 | ||
4875 | procedure TfrmFrame. HideEveryt hing(AMess age: strin g = 'No pa tient is c urrently s elected.') ; | |
4876 | begin | |
4877 | FNoPatie ntSelected := TRUE; | |
4878 | pnlNoPat ientSelect ed.Caption := AMessa ge; | |
4879 | pnlNoPat ientSelect ed.Visible := True; | |
4880 | pnlNoPat ientSelect ed.BringTo Front; | |
4881 | mnuFileR eview.Enab led := Fal se; | |
4882 | mnuFileP rint.Enabl ed := Fals e; | |
4883 | mnuFileP rintSelect edItems.En abled := F alse; | |
4884 | mnuFileE ncounter.E nabled := False; | |
4885 | mnuFileN ext.Enable d := False ; | |
4886 | mnuFileR efresh.Ena bled := Fa lse; | |
4887 | mnuFileP rintSetup. Enabled := False; | |
4888 | mnuFileP rintSelect edItems.En abled := F alse; | |
4889 | mnuFileN otifRemove .Enabled : = False; | |
4890 | mnuFileR esumeConte xt.Enabled := False; | |
4891 | mnuFileB reakContex t.Enabled := False; | |
4892 | mnuEdit. Enabled := False; | |
4893 | mnuView. Enabled := False; | |
4894 | mnuTools .Enabled : = False; | |
4895 | if FNext ButtonActi ve then FN extButton. Visible := False; | |
4896 | end; | |
4897 | ||
4898 | procedure TfrmFrame. ShowEveryt hing; | |
4899 | begin | |
4900 | FNoPatie ntSelected := FALSE; | |
4901 | pnlNoPat ientSelect ed.Caption := ''; | |
4902 | pnlNoPat ientSelect ed.Visible := False; | |
4903 | pnlNoPat ientSelect ed.SendToB ack; | |
4904 | mnuFileR eview.Enab led := Tru e; | |
4905 | mnuFileP rint.Enabl ed := True ; | |
4906 | mnuFileE ncounter.E nabled := True; | |
4907 | mnuFileN ext.Enable d := True; | |
4908 | mnuFileR efresh.Ena bled := Tr ue; | |
4909 | mnuFileP rintSetup. Enabled := True; | |
4910 | mnuFileP rintSelect edItems.En abled := T rue; | |
4911 | mnuFileN otifRemove .Enabled : = True; | |
4912 | if not F CCOWError then | |
4913 | begin | |
4914 | if FCC OWIconName = 'BMP_CCO W_BROKEN' then | |
4915 | begin | |
4916 | mnuF ileResumeC ontext.Ena bled := Tr ue; | |
4917 | mnuF ileBreakCo ntext.Enab led := Fal se; | |
4918 | end el se | |
4919 | begin | |
4920 | mnuF ileResumeC ontext.Ena bled := Fa lse; | |
4921 | mnuF ileBreakCo ntext.Enab led := Tru e; | |
4922 | end; | |
4923 | end; | |
4924 | mnuEdit. Enabled := True; | |
4925 | mnuView. Enabled := True; | |
4926 | mnuTools .Enabled : = True; | |
4927 | if FNext ButtonActi ve then FN extButton. Visible := True; | |
4928 | end; | |
4929 | ||
4930 | ||
4931 | procedure TfrmFrame. pnlFlagMou seDown(Sen der: TObje ct; Button : TMouseBu tton; | |
4932 | Shift: T ShiftState ; X, Y: In teger); | |
4933 | begin | |
4934 | pnlFlag. BevelOuter := bvLowe red; | |
4935 | end; | |
4936 | ||
4937 | procedure TfrmFrame. pnlFlagMou seUp(Sende r: TObject ; Button: TMouseButt on; | |
4938 | Shift: T ShiftState ; X, Y: In teger); | |
4939 | begin | |
4940 | pnlFlag. BevelOuter := bvRais ed; | |
4941 | end; | |
4942 | ||
4943 | procedure TfrmFrame. pnlOTHDCli ck(Sender: TObject); // rpk 1/ 5/2018 | |
4944 | var | |
4945 | tmpstr: String; | |
4946 | begin | |
4947 | inherite d; | |
4948 | tmpstr : = 'Other T han Honora ble Status ' + CRLF + CRLF + | |
4949 | OTHDLo ngStr1; | |
4950 | if OTHDL ongStr2 > '' then | |
4951 | tmpstr := tmpstr + CRLF + OTHDLongSt r2; | |
4952 | if OTHDL ocalMsg > '' then | |
4953 | tmpstr := tmpstr + CRLF + CRLF + OTH DLocalMsg; | |
4954 | ShowMsg( tmpstr); // rpk 2/2 8/2018 | |
4955 | end; | |
4956 | ||
4957 | procedure TfrmFrame. pnlOTHDEnt er(Sender: TObject); // rpk 1 /5/2018 | |
4958 | const | |
4959 | M_WVERT = 6; | |
4960 | begin | |
4961 | inherite d; | |
4962 | lblOTHDT itle.Capti on := 'Oth er than Ho norable: ' + OTHDLoc alMsg; | |
4963 | lblOTHD. Caption := OTHDLongS tr1; | |
4964 | if OTHDL ongStr2 > '' then | |
4965 | lblOTH D.Caption := lblOTHD .Caption + ', ' + OT HDLongStr2 ; | |
4966 | pnlOTHD. Width := Highe rOf( (lblO THDTitle.W idth + (M_ WVERT * 2) ), | |
4967 | (lbl OTHD.Width + (M_WVER T * 2)) ); // rpk 1 2/6/2017 | |
4968 | pnlOTHD. Left := pa VAA.Left - pnlOTHD.W idth; // r pk 1/4/201 8 | |
4969 | with Sen der as TPa nel do | |
4970 | BevelI nner := bv Raised; | |
4971 | end; | |
4972 | ||
4973 | procedure TfrmFrame. pnlOTHDExi t(Sender: TObject); // rpk 1/ 5/2018 | |
4974 | const | |
4975 | M_WVERT = 6; | |
4976 | begin | |
4977 | inherite d; | |
4978 | with Sen der as TPa nel do | |
4979 | BevelI nner := bv None; | |
4980 | lblOTHDT itle.Capti on := 'OTH '; | |
4981 | lblOTHD. Caption := OTHDShort Str; | |
4982 | pnlOTHD. Width := Highe rOf( (lblO THDTitle.W idth + (M_ WVERT * 2) ), | |
4983 | (lbl OTHD.Width + (M_WVER T * 2)) ); // rpk 1 2/6/2017 | |
4984 | pnlOTHD. Left := pa VAA.Left - pnlOTHD.W idth; // r pk 1/4/201 8 | |
4985 | lblPtCar e.Refresh; | |
4986 | lblPtAtt ending.Ref resh; | |
4987 | lblPtMHT C.Refresh; | |
4988 | end; | |
4989 | ||
4990 | ||
4991 | procedure TfrmFrame. pnlFlagCli ck(Sender: TObject); | |
4992 | begin | |
4993 | ViewInfo (mnuViewFl ags); | |
4994 | end; | |
4995 | ||
4996 | procedure TfrmFrame. mnuFilePri ntSelected ItemsClick (Sender: T Object); | |
4997 | begin | |
4998 | case T abToPageID (tabPage.T abIndex) o f | |
4999 | CT_N OTES: f rmNotes.Ls tNotesToPr int; | |
5000 | CT_C ONSULTS: f rmConsults .LstConsul tsToPrint; | |
5001 | CT_D CSUMM: f rmDCSumm.L stSummsToP rint; | |
5002 | end; {cas e} | |
5003 | end; | |
5004 | ||
5005 | procedure TfrmFrame. mnuAlertRe newClick(S ender: TOb ject); | |
5006 | var XQAID: string; | |
5007 | begin | |
5008 | XQAID := Piece(Not ifications .RecordID, '^', 2); | |
5009 | RenewAle rt(XQAID); | |
5010 | end; | |
5011 | ||
5012 | procedure TfrmFrame. mnuFileVie wNotificat ionsClick( Sender: TO bject); | |
5013 | begin | |
5014 | ShowPati entNotific ations(mnu FileNextCl ick); | |
5015 | end; | |
5016 | ||
5017 | procedure TfrmFrame. mnuAlertFo rwardClick (Sender: T Object); | |
5018 | var | |
5019 | XQAID, A lertMsg: s tring; | |
5020 | begin | |
5021 | XQAID := Piece(Not ifications .RecordID, '^', 2); | |
5022 | AlertMsg := Piece( Notificati ons.Record ID, '^', 1 ); | |
5023 | RenewAle rt(XQAID); // must renew/rest ore an ale rt before it can be forwarded | |
5024 | ForwardA lertTo(XQA ID + '^' + AlertMsg) ; | |
5025 | end; | |
5026 | ||
5027 | procedure TfrmFrame. mnuGECStat usClick(Se nder: TObj ect); | |
5028 | var | |
5029 | ans, Resul t,str,str1 ,title: st ring; | |
5030 | cnt,i: int eger; | |
5031 | fin: boole an; | |
5032 | ||
5033 | begin | |
5034 | // Result := sCallV ('ORQQPXRM GEC STATU S PROMPT', [Patient. DFN]); | |
5035 | if CallV istA('ORQQ PXRM GEC S TATUS PROM PT', [Pati ent.DFN],R esult) and | |
5036 | (Piece (Result,U, 1) <> '0') then | |
5037 | begin | |
5038 | titl e := Piece (Result,U, 2); | |
5039 | if pos('~',P iece(Resul t,U,1))>0 then | |
5040 | begin | |
5041 | str:= ''; | |
5042 | str1 := Piece(R esult,U,1) ; | |
5043 | cnt : = DelimCou nt(str1, ' ~'); | |
5044 | for i :=1 to cnt +1 do | |
5045 | b egin | |
5046 | i f i = 1 th en str := Piece(str1 ,'~',i); | |
5047 | i f i > 1 th en str :=s tr+CRLF+Pi ece(str1,' ~',i); | |
5048 | e nd; | |
5049 | end | |
5050 | else st r := Piece (Result,U, 1); | |
5051 | if Piece(Res ult,U,3)=' 1' then | |
5052 | begin | |
5053 | fin := (InfoBox(s tr,title, MB_YESNO o r MB_DEFBU TTON2)=IDY ES); | |
5054 | if fin = true the n ans := ' 1'; | |
5055 | if fin = false th en ans := '0'; | |
5056 | // CallV ('ORQQPXRM GEC FINIS HED?',[Pat ient.DFN,a ns]); | |
5057 | CallVis tA('ORQQPX RM GEC FIN ISHED?',[P atient.DFN ,ans]); | |
5058 | end | |
5059 | el se | |
5060 | In foBox(str, title, MB_ OK); | |
5061 | end; | |
5062 | end; | |
5063 | ||
5064 | procedure TfrmFrame. pnlFlagEnt er(Sender: TObject); | |
5065 | begin | |
5066 | pnlFlag. BevelInner := bvRais ed; | |
5067 | pnlFlag. BevelOuter := bvNone ; | |
5068 | pnlFlag. BevelWidth := 3; | |
5069 | end; | |
5070 | ||
5071 | procedure TfrmFrame. pnlFlagExi t(Sender: TObject); | |
5072 | begin | |
5073 | pnlFlag. BevelWidth := 2; | |
5074 | pnlFlag. BevelInner := bvNone ; | |
5075 | pnlFlag. BevelOuter := bvRais ed; | |
5076 | end; | |
5077 | ||
5078 | procedure TfrmFrame. tabPageMou seDown(Sen der: TObje ct; Button : TMouseBu tton; | |
5079 | Shift: T ShiftState ; X, Y: In teger); | |
5080 | begin | |
5081 | inherite d; | |
5082 | TabCtrlC licked := True; | |
5083 | end; | |
5084 | ||
5085 | procedure TfrmFrame. tabPageMou seUp(Sende r: TObject ; Button: TMouseButt on; | |
5086 | Shift: T ShiftState ; X, Y: In teger); | |
5087 | begin | |
5088 | LastTab := TabToPa geID((send er as TTab Control).T abIndex); | |
5089 | end; | |
5090 | ||
5091 | procedure TfrmFrame. lstCIRNLoc ationsExit (Sender: T Object); | |
5092 | begin | |
5093 | //Make the lstCI RNLocation s act as i f between pnlCIRN & pnlReminde rs | |
5094 | //in t he Tab Ord er | |
5095 | if Boole an(Hi(GetK eyState(VK _TAB))) th en | |
5096 | if Boo lean(Hi(Ge tKeyState( VK_SHIFT)) ) then | |
5097 | pnlC IRN.SetFoc us | |
5098 | else | |
5099 | pnlR eminders.S etFocus; | |
5100 | end; | |
5101 | ||
5102 | procedure TfrmFrame. AppEventsA ctivate(Se nder: TObj ect); | |
5103 | begin | |
5104 | FJustEnt eredApp := True; | |
5105 | end; | |
5106 | ||
5107 | procedure TfrmFrame. AppEventsM essage(var Msg: tagM SG; var Ha ndled: Boo lean); | |
5108 | var | |
5109 | Control: TComponen t; | |
5110 | begin | |
5111 | Handled := false; | |
5112 | if (Msg. message = WM_MOUSEWH EEL) and ( GetKeyStat e(VK_LBUTT ON) < 0) t hen begin | |
5113 | Contro l := FindC ontrol(Msg .hwnd); | |
5114 | if not Assigned( Control) t hen | |
5115 | Hand led := Tru e | |
5116 | else i f (Control is TRichE dit) then begin | |
5117 | Hand led := Tru e; | |
5118 | Send Message(se lf.Handle, EM_SETZOO M, 0, 0); | |
5119 | end; | |
5120 | end; | |
5121 | end; | |
5122 | ||
5123 | procedure TfrmFrame. ScreenActi veFormChan ge(Sender: TObject); | |
5124 | begin | |
5125 | if(assig ned(FOldAc tiveFormCh ange)) the n | |
5126 | FOldAc tiveFormCh ange(Sende r); | |
5127 | //Focus the Form t hat Stays on Top aft er the App lication R egains foc us. | |
5128 | if FJust EnteredApp then | |
5129 | FocusA pplication TopForm; | |
5130 | FJustEnt eredApp := false; | |
5131 | end; | |
5132 | ||
5133 | procedure TfrmFrame. FocusAppli cationTopF orm; | |
5134 | var | |
5135 | I : inte ger; | |
5136 | begin | |
5137 | for I := (Screen.F ormCount-1 ) downto 0 do //Set the last o ne opened last | |
5138 | begin | |
5139 | with S creen.Form s[I] do | |
5140 | if ( FormStyle = fsStayOn Top) and ( Enabled) a nd (Visibl e) then | |
5141 | Se tFocus; | |
5142 | end; | |
5143 | end; | |
5144 | ||
5145 | procedure TfrmFrame. AppEventsS hortCut(va r Msg: TWM Key; | |
5146 | var Hand led: Boole an); | |
5147 | begin | |
5148 | if ((Boo lean(Hi(Ge tKeyState( VK_MENU{AL T})))) and (Msg.Char Code = VK_ F1)) then | |
5149 | begin | |
5150 | FocusA pplication TopForm; | |
5151 | Handle d := True; | |
5152 | end; | |
5153 | end; | |
5154 | ||
5155 | procedure TfrmFrame. mnuToolsGr aphingClic k(Sender: TObject); | |
5156 | var | |
5157 | contexth int: strin g; | |
5158 | begin | |
5159 | Screen.C ursor := c rHourGlass ; | |
5160 | contexth int := mnu ToolsGraph ing.Hint; | |
5161 | if Graph Float = ni l then // new gra ph | |
5162 | begin | |
5163 | GraphF loat := Tf rmGraphs.C reate(self ); | |
5164 | try | |
5165 | with GraphFloa t do | |
5166 | begi n | |
5167 | if btnClose. Tag = 1 th en | |
5168 | be gin | |
5169 | Screen.Cur sor := crD efault; | |
5170 | exit; | |
5171 | en d; | |
5172 | In itialize; | |
5173 | Ca ption := ' CPRS Graph ing - Pati ent: ' + M ixedCase(P atient.Nam e); | |
5174 | Bo rderIcons := [biSyst emMenu, bi Maximize, biMinimize ]; | |
5175 | Bo rderStyle := bsSizea ble; | |
5176 | Bo rderWidth := 1; | |
5177 | // context s ensitive type (tabPage.T abIndex) & [item] | |
5178 | Re sizeAnchor edFormToFo nt(GraphFl oat); | |
5179 | Gr aphFloat.p nlFooter.H int := con texthint; // conte xt from la b most rec ent | |
5180 | Sh ow; | |
5181 | end; | |
5182 | finall y | |
5183 | if G raphFloat. btnClose.T ag = 1 the n | |
5184 | begi n | |
5185 | Gr aphFloatAc tive := fa lse; | |
5186 | Gr aphFloat.F ree; | |
5187 | Gr aphFloat : = nil; | |
5188 | end | |
5189 | else | |
5190 | Gr aphFloatAc tive := tr ue; | |
5191 | end; | |
5192 | end | |
5193 | else | |
5194 | begin | |
5195 | GraphF loat.Capti on := 'CPR S Graphing - Patient : ' + Mixe dCase(Pati ent.Name); | |
5196 | GraphF loat.pnlFo oter.Hint := context hint; // context f rom lab mo st recent | |
5197 | if Gra phFloat.bt nClose.Tag = 1 then | |
5198 | begin | |
5199 | Scre en.Cursor := crDefau lt; | |
5200 | exit ; | |
5201 | end | |
5202 | else i f GraphFlo atActive a nd (frmGra phData.pnl Data.Hint = Patient. DFN) then | |
5203 | begin | |
5204 | if l ength(Grap hFloat.pnl Footer.Hin t) > 1 the n | |
5205 | begi n | |
5206 | Gr aphFloat.C lose; | |
5207 | Gr aphFloatAc tive := tr ue; | |
5208 | Gr aphFloat.S how; | |
5209 | end; | |
5210 | Grap hFloat.Bri ngToFront; // grap h is activ e, same pa tient | |
5211 | end | |
5212 | else i f frmGraph Data.pnlDa ta.Hint = Patient.DF N then | |
5213 | begin // graph is not ac tive, same patient | |
5214 | // c ontext sen sitive | |
5215 | Grap hFloat.Sho w; | |
5216 | Grap hFloatActi ve := true ; | |
5217 | end | |
5218 | else | |
5219 | //with GraphFloa t do // new patient | |
5220 | begin | |
5221 | Grap hFloat.Ini tialRetain ; | |
5222 | Grap hFloatActi ve := fals e; | |
5223 | Grap hFloat.Fre e; | |
5224 | Grap hFloat := nil; | |
5225 | mnuT oolsGraphi ngClick(se lf); // del ete and re curse | |
5226 | end; | |
5227 | end; | |
5228 | mnuTools Graphing.H int := ''; | |
5229 | Screen.C ursor := c rDefault; | |
5230 | end; | |
5231 | ||
5232 | procedure TfrmFrame. pnlCIRNMou seDown(Sen der: TObje ct; Button : TMouseBu tton; Shif t: TShiftS tate; X, Y : Integer) ; | |
5233 | begin | |
5234 | pnlCIRN. BevelOuter := bvLowe red; | |
5235 | end; | |
5236 | ||
5237 | procedure TfrmFrame. pnlCIRNMou seUp(Sende r: TObject ; Button: TMouseButt on; Shift: TShiftSta te; X, Y: Integer); | |
5238 | begin | |
5239 | pnlCIRN. BevelOuter := bvRais ed; | |
5240 | end; | |
5241 | ||
5242 | procedure TfrmFrame. laMHVClick (Sender: T Object); | |
5243 | begin | |
5244 | ViewInfo (mnuViewMy HealtheVet ); | |
5245 | end; | |
5246 | ||
5247 | procedure TfrmFrame. laVAA2Clic k(Sender: TObject); | |
5248 | begin | |
5249 | ViewInfo (mnuInsura nce); | |
5250 | end; | |
5251 | ||
5252 | procedure TfrmFrame. lblOTHDCli ck(Sender: TObject); // rpk 1/ 5/2018 | |
5253 | begin | |
5254 | inherite d; | |
5255 | pnlOTHDC lick(lblOT HD); | |
5256 | end; | |
5257 | ||
5258 | procedure TfrmFrame. lblOTHDTit leClick(Se nder: TObj ect); // rpk 1/5/20 18 | |
5259 | begin | |
5260 | inherite d; | |
5261 | pnlOTHDC lick(lblOT HDTitle); | |
5262 | end; | |
5263 | ||
5264 | procedure TfrmFrame. ViewInfo(S ender: TOb ject); | |
5265 | var | |
5266 | SelectNe w: Boolean ; | |
5267 | { TODO 5 -oDanP -c New CoverS heet : Nee d to finis h the VAA button stu ff ASAP! } | |
5268 | aInsuran ceSubscrib erName: st ring; | |
5269 | aReportT ext: TStri ngList; | |
5270 | aAddress : string; | |
5271 | ID: inte ger; | |
5272 | aCPRS508 : ICPRS508 ; | |
5273 | sl: TStr ings; | |
5274 | begin | |
5275 | if Sende r is TMenu Item then begin | |
5276 | ID := TMenuItem( Sender).Ta g; | |
5277 | end else if Sender is TActio n then beg in | |
5278 | ID := TAction(Se nder).Tag; | |
5279 | end else begin | |
5280 | ID := -1; | |
5281 | end; | |
5282 | case ID of | |
5283 | 1:begi n { displa ys patient inquiry r eport (whi ch optiona lly allows new patie nt to be s elected) } | |
5284 | St atusText(T X_PTINQ); | |
5285 | Pa tientInqui ry(SelectN ew); | |
5286 | if Assigned( FLastPage) then | |
5287 | if FLastPa ge.Inherit sFrom(Tfrm Page) then | |
5288 | TfrmPage (FLastPage ).FocusFir stControl | |
5289 | else if Su pports(fLa stPage, IC PRS508, aC PRS508) th en | |
5290 | aCPRS508 .OnFocusFi rstControl (Sender); | |
5291 | St atusText(' '); | |
5292 | if SelectNew then mnuF ileOpenCli ck(mnuView Demo); | |
5293 | end; | |
5294 | 2:begi n | |
5295 | if (not User .IsReports Only) then // Report s Only tab . | |
5296 | mnuFileEnc ounterClic k(Self); | |
5297 | end; | |
5298 | 3:begi n | |
5299 | sl := TSTrin gList.Crea te; | |
5300 | tr y | |
5301 | setDetailP rimaryCare (sl,Patien t.DFN); | |
5302 | ReportBox( sl, 'Prima ry Care', True); | |
5303 | fi nally | |
5304 | sl.Free; | |
5305 | en d; | |
5306 | end; | |
5307 | 4:begi n | |
5308 | if Patient.P tIsMHV the n | |
5309 | ShellExecu te(laMHV.H andle, 'op en', PChar ('http://w ww.myhealt h. DNS /'), '', ' ', SW_NORM AL); | |
5310 | end; | |
5311 | 5:begi n | |
5312 | if Patient.Pt IsVAA then | |
5313 | t ry | |
5314 | aReportTe xt := TStr ingList.Cr eate; | |
5315 | Patient.G etVAAInfor mation(aIn suranceSub scriberNam e, aReport Text); | |
5316 | ReportBox (aReportTe xt, aInsur anceSubscr iberName, True); | |
5317 | f inally | |
5318 | FreeAndNi l(aReportT ext); | |
5319 | e nd; | |
5320 | end; | |
5321 | 6:begi n | |
5322 | Sh owFlags; | |
5323 | end; | |
5324 | 7:begi n | |
5325 | if uUseVista Web = true then | |
5326 | begin | |
5327 | lblCIRN. Alignment := taCente r; | |
5328 | lstCIRNL ocations.V isible := false; | |
5329 | lstCIRNL ocations.S endToBack; | |
5330 | aAddress := GetVis taWebAddre ss(Patient .DFN); | |
5331 | ShellExe cute(pnlCi rn.Handle, 'open', P Char(aAddr ess), PCha r(''), '', SW_NORMAL ); | |
5332 | pnlCIRN. BevelOuter := bvRais ed; | |
5333 | Exit; | |
5334 | end; | |
5335 | if not Remot eSites.Rem oteDataExi sts then E xit; | |
5336 | if (not lstC IRNLocatio ns.Visible ) then | |
5337 | begin | |
5338 | pnlCIRN. BevelOuter := bvLowe red; | |
5339 | lstCIRNL ocations.V isible := True; | |
5340 | lstCIRNL ocations.B ringToFron t; | |
5341 | lstCIRNL ocations.S etFocus; | |
5342 | pnlCIRN. Hint := 'C lick to cl ose list.' ; | |
5343 | end | |
5344 | el se | |
5345 | begin | |
5346 | pnlCIRN. BevelOuter := bvRais ed; | |
5347 | lstCIRNL ocations.V isible := False; | |
5348 | lstCIRNL ocations.S endToBack; | |
5349 | pnlCIRN. Hint := 'C lick to di splay othe r faciliti es having data for t his patien t.'; | |
5350 | end; | |
5351 | end; | |
5352 | 8:begi n | |
5353 | Vi ewReminder Tree; | |
5354 | end; | |
5355 | 9:begi n { displa ys the win dow that s hows crisi s notes, w arnings, a llergies, & advance directives } | |
5356 | Sh owCWAD; | |
5357 | end; | |
5358 | end; | |
5359 | end; | |
5360 | ||
5361 | procedure TfrmFrame. mnuViewInf ormationCl ick(Sender : TObject) ; | |
5362 | begin | |
5363 | mnuViewD emo.Enable d := frmFr ame.pnlPat ient.Enabl ed; | |
5364 | mnuViewV isits.Enab led := frm Frame.pnlV isit.Enabl ed; | |
5365 | mnuViewP rimaryCare .Enabled : = frmFrame .pnlPrimar yCare.Enab led; | |
5366 | mnuViewM yHealtheVe t.Enabled := not (Co py(frmFram e.laMHV.Hi nt, 1, 2) = 'No'); | |
5367 | mnuInsur ance.Enabl ed := not (Copy(frmF rame.laVAA 2.Hint, 1, 2) = 'No' ); | |
5368 | mnuViewF lags.Enabl ed := frmF rame.lblFl ag.Enabled ; | |
5369 | mnuViewR emoteData. Enabled := frmFrame. lblCirn.En abled; | |
5370 | mnuViewR eminders.E nabled := frmFrame.p nlReminder s.Enabled; | |
5371 | mnuViewP ostings.En abled := f rmFrame.pn lPostings. Enabled; | |
5372 | end; | |
5373 | ||
5374 | procedure TfrmFrame. SetActiveT ab(PageID: Integer); | |
5375 | begin | |
5376 | tabPage. TabIndex : = frmFrame .PageIDToT ab(PageID) ; | |
5377 | tabPageC hange(tabP age); | |
5378 | end; | |
5379 | ||
5380 | procedure TfrmFrame. NextButton Click(Send er: TObjec t); | |
5381 | begin | |
5382 | if FProc cessingNex tClick the n Exit; | |
5383 | FProcces singNextCl ick := tru e; | |
5384 | popAlert s.AutoPopu p := TRUE; | |
5385 | mnuFileN ext.Enable d := True; | |
5386 | mnuFileN extClick(S elf); | |
5387 | FProcces singNextCl ick := fal se; | |
5388 | end; | |
5389 | ||
5390 | procedure TfrmFrame. NextButton MouseDown( Sender: TO bject; But ton: TMous eButton; | |
5391 | Shif t: TShiftS tate; X, Y : Integer) ; | |
5392 | begin | |
5393 | popAler ts.AutoPop up := TRUE ; | |
5394 | end; | |
5395 | ||
5396 | procedure TfrmFrame. SetUpNextB utton; | |
5397 | begin | |
5398 | if FNex tButton <> nil then | |
5399 | begin | |
5400 | FNex tButton.fr ee; | |
5401 | FNex tButton := nil; | |
5402 | end; | |
5403 | FNextBu tton := TB itBtn.Crea te(self); | |
5404 | FNextBu tton.Paren t:= frmFra me; | |
5405 | FNextBu tton.Glyph := FNextB uttonBitma p; | |
5406 | FNextBu tton.OnMou seDown := NextButton MouseDown; | |
5407 | FNextBu tton.OnCli ck := Next ButtonClic k; | |
5408 | FNextBu tton.Capti on := '&Ne xt'; | |
5409 | FNextBu tton.Popup Menu := po pAlerts; | |
5410 | FNextBu tton.Top : = stsArea. Top; | |
5411 | FNextBu tton.Left := FNextBu ttonL; | |
5412 | FNextBu tton.Heigh t := stsAr ea.Height; | |
5413 | FNextBu tton.Width := stsAre a.Panels[2 ].Width; | |
5414 | FNextBu tton.TabSt op := True ; | |
5415 | FNextBu tton.TabOr der := 1; | |
5416 | FNextBu tton.show; | |
5417 | end; | |
5418 | ||
5419 | Procedure TfrmFrame. GetExclude dFromMixed (); | |
5420 | var | |
5421 | VistaList : TStringL ist; | |
5422 | I: intege r; | |
5423 | begin | |
5424 | VistaList := TStrin gList.Crea te; | |
5425 | try | |
5426 | GetUserL istParam(V istaList, 'OR EXCLUD E FROM MIX CASE'); | |
5427 | if Vista List.Count > 0 then | |
5428 | begin | |
5429 | Exclud eFromMixed .Clear; | |
5430 | for I := 0 to Vi staList.Co unt - 1 do | |
5431 | Excl udeFromMix ed.Add(Mix edCase(Pie ce(VistaLi st[I], U, 2), True)) ; | |
5432 | end; | |
5433 | finally | |
5434 | VistaLis t.Free; | |
5435 | end; | |
5436 | end; | |
5437 | ||
5438 | // PaPI == ========== ========== ========== ========== ========== ========== ========== | |
5439 | procedure TfrmFrame. UMEncUpd(v ar Message : TMessage ); | |
5440 | begin | |
5441 | try | |
5442 | frmMed s.PaPI_GUI Setup(papi ParkingAva ilable(Enc ounter)); | |
5443 | except | |
5444 | on E: Exception do | |
5445 | Show Message(E. Message); | |
5446 | end; | |
5447 | end; | |
5448 | ||
5449 | procedure TfrmFrame. UMPAPI(var Message: TMessage); | |
5450 | begin | |
5451 | try | |
5452 | tabPag e.TabIndex := Messag e.WParam; | |
5453 | tabPag eChange(ta bPage); | |
5454 | except | |
5455 | on E: Exception do | |
5456 | Show Message(E. Message); | |
5457 | end; | |
5458 | end; | |
5459 | ||
5460 | initializa tion | |
5461 | SpecifyF ormIsNotAD ialog(Tfrm Frame); | |
5462 | ||
5463 | finalizati on | |
5464 | ||
5465 | ||
5466 | end. |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.