source: cprs/branches/tmg-cprs/CPRS-Chart/fPtAdd.pas@ 745

Last change on this file since 745 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69
File size: 17.9 KB
Line 
1unit fPtAdd;
2//kt This entire module and form was added. Coded by Eddie Hagood 10/2007
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
8 Dialogs, StdCtrls, Trpcb, mfunstr, ORNet, uCore, ExtCtrls, StrUtils,
9 Buttons;
10
11type
12 TPatientInfo = class(TObject)
13 public
14 LName: String;
15 FName: String;
16 MName: String;
17 CombinedName: String;
18 Suffix: String;
19 DOB: String;
20 Sex: String;
21 SSNum: String;
22 PtType: String;
23 Veteran: String;
24 procedure ClearArray;
25 end;
26
27 TfrmPtAdd = class(TForm)
28 LNameLabel: TLabel;
29 SexComboBox: TComboBox;
30 SSNumEdit: TEdit;
31 DOBEdit: TEdit;
32 SuffixEdit: TEdit;
33 MNameEdit: TEdit;
34 FNameEdit: TEdit;
35 LNameEdit: TEdit;
36 FNameLabel: TLabel;
37 MNameLabel: TLabel;
38 SuffixLabel: TLabel;
39 DOBLabel: TLabel;
40 SSNumLabel: TLabel;
41 SexLabel: TLabel;
42 PrefixLabel: TLabel;
43 PtTypeComboBox: TComboBox;
44 VeteranCheckBox: TCheckBox;
45 OkButton: TButton;
46 CloseButton: TButton;
47 Label1: TLabel;
48 SSNHelpBtn: TSpeedButton;
49 Label2: TLabel;
50 procedure OnShow(Sender: TObject);
51 procedure CancelButtonClick(Sender: TObject);
52 procedure OkButtonClick(Sender: TObject);
53 procedure LNameEditChange(Sender: TObject);
54 procedure FNameEditChange(Sender: TObject);
55 procedure DOBEditChange(Sender: TObject);
56 procedure SSNumEditChange(Sender: TObject);
57 procedure SexComboBoxChange(Sender: TObject);
58 procedure MNameEditChange(Sender: TObject);
59 procedure SuffixEditChange(Sender: TObject);
60 procedure PtTypeComboBoxChange(Sender: TObject);
61 procedure VeteranCheckBoxClick(Sender: TObject);
62 procedure FormCreate(Sender: TObject);
63 procedure SSNumEditExit(Sender: TObject);
64 procedure SSNumEditKeyPress(Sender: TObject; var Key: Char);
65 procedure DOBEditKeyPress(Sender: TObject; var Key: Char);
66 procedure LNameEditKeyPress(Sender: TObject; var Key: Char);
67 procedure FNameEditKeyPress(Sender: TObject; var Key: Char);
68 procedure MNameEditKeyPress(Sender: TObject; var Key: Char);
69 procedure SuffixEditKeyPress(Sender: TObject; var Key: Char);
70 procedure SexComboBoxKeyPress(Sender: TObject; var Key: Char);
71 procedure PtTypeComboBoxKeyPress(Sender: TObject; var Key: Char);
72 procedure FormDestroy(Sender: TObject);
73 procedure DOBEditExit(Sender: TObject);
74 procedure SSNHelpBtnClick(Sender: TObject);
75 private
76 { Private declarations }
77 ThisPatientInfo: TPatientInfo;
78 ProgModSSNum : boolean;
79 procedure ResetColors();
80 procedure ResetFields();
81 procedure TestUserInput();
82 procedure DataToArray();
83 procedure CreatePSSN();
84 procedure PostInfo(ThisPatientInfo : TPatientInfo);
85 function FrmtSSNum(SSNumStr : string) : string;
86 function UnFrmtSSNum(SSNumStr : string) : string;
87 function SSNumInvalid(SSNumStr: string) : boolean;
88 public
89 { Public declarations }
90 DFN: Int64;
91 end;
92
93var
94 frmPtAdd: TfrmPtAdd;
95
96implementation
97
98uses fPtSel;
99
100{$R *.dfm}
101
102var
103 boolErrorFound: boolean;
104 boolDirtyForm: boolean;
105
106procedure TfrmPtAdd.OnShow(Sender: TObject);
107begin
108 LNameEdit.SetFocus;
109 PtTypeComboBox.Text := 'NON-VETERAN (OTHER)';
110 ResetColors;
111 ResetFields;
112 ThisPatientInfo.ClearArray;
113 boolDirtyForm := False;
114 DFN := -1;
115end;
116//------------------------------------------------------------------------
117procedure TfrmPtAdd.CancelButtonClick(Sender: TObject);
118begin
119 if (boolDirtyForm = True) then begin
120 if MessageDlg('** Patient Not Yet Added **'+#10+#13+
121 'ADD this patient before exiting?',
122 mtWarning, [mbYes, mbNo],0) = mrYes then begin
123 OkButtonClick(self);
124 end else begin
125 modalresult:=1;
126 end;
127 end else begin
128 modalresult:=1;
129 end;
130end;
131//------------------------------------------------------------------------
132procedure TfrmPtAdd.ResetColors();
133begin
134 LNameEdit.Color := clWindow;
135 FNameEdit.Color := clWindow;
136 DOBEdit.Color := clWindow;
137 SSNumEdit.Color := clWindow;
138 SexComboBox.Color := clWindow;
139end;
140//------------------------------------------------------------------------
141procedure TfrmPtAdd.ResetFields();
142begin
143 LNameEdit.text := '';
144 FNameEdit.text := '';
145 MNameEdit.text := '';
146 SuffixEdit.Text := '';
147 PtTypeComboBox.Text := 'NON-VETERAN (OTHER)';
148 DOBEdit.text := '';
149 SSNumEdit.text := '';
150 SexComboBox.text := '<Sex>';
151 Label1.Visible := False;
152 Label1.Caption := '';
153 VeteranCheckbox.Checked := False;
154end;
155//------------------------------------------------------------------------
156
157procedure TfrmPtAdd.OkButtonClick(Sender: TObject);
158
159begin
160 TestUserInput;
161 if boolErrorFound = False then begin
162 DataToArray;
163 PostInfo(ThisPatientInfo);
164 boolDirtyForm := False;
165 ThisPatientInfo.ClearArray;
166 modalresult:=1;
167 end else begin
168 label1.Caption := 'Needs: ' + label1.caption;
169 label1.Visible := True;
170 end;
171end;
172//------------------------------------------------------------------------
173procedure TfrmPtAdd.LNameEditChange(Sender: TObject);
174begin
175 ResetColors;
176 ThisPatientInfo.LName := LNameEdit.Text;
177 boolDirtyForm := True;
178 label1.Visible := False;
179 if Pos('P',SSNumEdit.Text) > 0 then begin
180 CreatePSSN();
181 end;
182end;
183//------------------------------------------------------------------------
184procedure TfrmPtAdd.FNameEditChange(Sender: TObject);
185begin
186 ResetColors;
187 ThisPatientInfo.FName := FNameEdit.Text;
188 boolDirtyForm := True;
189 label1.Visible := False;
190 if Pos('P',SSNumEdit.Text) > 0 then begin
191 CreatePSSN();
192 end;
193end;
194//------------------------------------------------------------------------
195procedure TfrmPtAdd.MNameEditChange(Sender: TObject);
196begin
197 ThisPatientInfo.MName := MNameEdit.Text;
198 boolDirtyForm := True;
199 label1.Visible := False;
200 if Pos('P',SSNumEdit.Text) > 0 then begin
201 CreatePSSN();
202 end;
203end;
204//------------------------------------------------------------------------
205procedure TfrmPtAdd.DOBEditChange(Sender: TObject);
206begin
207 ResetColors;
208 label1.Visible := False;
209 ThisPatientInfo.DOB := DOBEdit.Text;
210 if Pos('P',SSNumEdit.Text) > 0 then begin
211 CreatePSSN();
212 end;
213end;
214//------------------------------------------------------------------------
215procedure TfrmPtAdd.SSNumEditChange(Sender: TObject);
216begin
217 if ProgModSSNum = false then begin
218 ResetColors;
219 ThisPatientInfo.SSNum := UnFrmtSSNum(SSNumEdit.Text);
220 //ProgModSSNum := true;
221 //SSNumEdit.Text := FrmtSSNum(ThisPatientInfo.SSNum);
222 //ProgModSSNum := false;
223 boolDirtyForm := True;
224 label1.Visible := False;
225 end;
226end;
227//------------------------------------------------------------------------
228procedure TfrmPtAdd.SexComboBoxChange(Sender: TObject);
229begin
230 ResetColors;
231 ThisPatientInfo.Sex := SexComboBox.Text;
232 boolDirtyForm := True;
233 label1.Visible := False;
234end;
235//------------------------------------------------------------------------
236
237procedure TfrmPtAdd.TestUserInput();
238begin
239 boolErrorFound := False;
240 label1.caption := '';
241 label1.Visible := False;
242 ResetColors;
243
244 if SSNumInvalid(ThisPatientInfo.SSNum) then begin
245 if MessageDlg('Invalid SSN. Would you like to use a pseudo-SSN?', mtConfirmation, [mbYes, mbNo],0) = mrYes then begin
246 SSNumEdit.Text := 'p';
247 end else begin
248 label1.Caption := label1.Caption + 'SSN,';
249 boolErrorFound := True;
250 SSNumEdit.Color := clYellow;
251 end;
252 end;
253
254 if LNameEdit.Text = '' then begin
255 label1.Caption := 'Last Name,';
256 boolErrorFound := True;
257 LNameEdit.Color := clYellow;
258 end;
259 if FNameEdit.Text = '' then begin
260 label1.Caption := label1.Caption + 'First Name,';
261 boolErrorFound := True;
262 FNameEdit.Color := clYellow;
263 end;
264 if DOBEdit.Text = '' then begin
265 label1.Caption := label1.Caption + 'DOB,';
266 boolErrorFound := True;
267 DOBEdit.Color := clYellow;
268 end;
269
270 if SexComboBox.Text = '<Sex>' then begin
271 label1.Caption := label1.Caption + 'Gender';
272 boolErrorFound := True;
273 SexComboBox.Color := clYellow;
274 end;
275
276end;
277//------------------------------------------------------------------------
278procedure TfrmPtAdd.DataToArray();
279
280begin
281 ThisPatientInfo.ClearArray;
282 ThisPatientInfo.LName := LNameEdit.Text;
283 ThisPatientInfo.FName := FNameEdit.Text;
284 ThisPatientInfo.MName := MNameEdit.Text;
285 ThisPatientInfo.Suffix := SuffixEdit.Text;
286 ThisPatientInfo.DOB := DOBEdit.Text;
287 ThisPatientInfo.Sex := SexComboBox.Text;
288
289 if Uppercase(SSNumEdit.Text) = 'P' then begin
290 CreatePSSN;
291 end else begin
292 ThisPatientInfo.SSNum := UnFrmtSSNum(SSNumEdit.Text);
293 end;
294
295 ThisPatientInfo.PtType := PtTypeComboBox.Text;
296 if VeteranCheckBox.Checked = True then ThisPatientInfo.Veteran := 'True' else ThisPatientInfo.Veteran := 'False';
297
298end;
299//------------------------------------------------------------------------
300procedure TPatientInfo.ClearArray;
301begin
302 LName := '';
303 FName := '';
304 MName := '';
305 Suffix := '';
306 DOB := '';
307 Sex := '';
308 SSNum := '';
309 PtType := '';
310 Veteran := '';
311end;
312//------------------------------------------------------------------------
313procedure TfrmPtAdd.SuffixEditChange(Sender: TObject);
314begin
315 ThisPatientInfo.Suffix := SuffixEdit.Text;
316 boolDirtyForm := True;
317end;
318//------------------------------------------------------------------------
319procedure TfrmPtAdd.PtTypeComboBoxChange(Sender: TObject);
320begin
321 ThisPatientInfo.PtType := PtTypeComboBox.Text;
322 boolDirtyForm := True;
323end;
324//------------------------------------------------------------------------
325procedure TfrmPtAdd.VeteranCheckBoxClick(Sender: TObject);
326begin
327 if VeteranCheckBox.Checked = True then ThisPatientInfo.Veteran := 'True' else ThisPatientInfo.Veteran := 'False';
328 boolDirtyForm := True;
329end;
330//------------------------------------------------------------------------
331procedure TfrmPtAdd.FormCreate(Sender: TObject);
332begin
333 ThisPatientInfo := TPatientInfo.Create;
334 DFN := -1;
335 ProgModSSNum := false;
336end;
337//------------------------------------------------------------------------
338procedure TfrmPtAdd.SSNumEditExit(Sender: TObject);
339begin
340 ProgModSSNum := true;
341 SSNumEdit.Text := FrmtSSNum(ThisPatientInfo.SSNum);
342 ProgModSSNum := false;
343
344 if (SSNumInvalid(ThisPatientInfo.SSNum)) and (SSNumEdit.Text <>'') then begin
345 label1.Caption := 'SSN not correct length';
346 label1.Visible := True;
347 SSNumEdit.Color := clYellow;
348 end;
349end;
350//------------------------------------------------------------------------
351function TfrmPtAdd.SSNumInvalid(SSNumStr: string) : boolean;
352var targetLen : byte;
353begin
354 if Pos('P',SSNumStr)>0 then targetLen := 10 else targetLen := 9;
355 Result := (length(SSNumStr) <> targetLen);
356end;
357//------------------------------------------------------------------------
358procedure TfrmPtAdd.SSNumEditKeyPress(Sender: TObject; var Key: Char);
359begin
360 if Key = 'p' then Key := 'P';
361 if Key=#8 then begin
362 if Pos('P',SSNumEdit.Text)>0 then begin
363 SSNumEdit.Text := '';
364 Key := #0;
365 end;
366 end else if Key='P' then begin
367 CreatePSSN;
368 Key := #0;
369 end else if not (Key in ['0'..'9','-']) then Key := #0;
370end;
371//------------------------------------------------------------------------
372function TfrmPtAdd.FrmtSSNum(SSNumStr : string) : string;
373var partA,partB,partC : string;
374begin
375 partA := MidStr(SSNumStr,1,3);
376 partB := MidStr(SSNumStr,4,2);
377 partC := MidStr(SSNumStr,6,5);
378 Result := partA;
379 if length(partA)=3 then begin
380 Result := Result + '-' + partB;
381 if partC<>'' then begin
382 Result := Result + '-' + partC;
383 end;
384 end else begin
385 Result := SSNumStr;
386 end;
387end;
388//------------------------------------------------------------------------
389function TfrmPtAdd.UnFrmtSSNum(SSNumStr : string) : string;
390begin
391 Result := AnsiReplaceText(SSNumStr,'-','');
392end;
393//------------------------------------------------------------------------
394procedure TfrmPtAdd.DOBEditKeyPress(Sender: TObject; var Key: Char);
395begin
396 if Key in ['-', '\'] then Key := '/';
397 if Key in ['0'..'9'] + ['/'] then Key := Key
398 else if Key <> #8 then Key := #0;
399end;
400//------------------------------------------------------------------------
401procedure TfrmPtAdd.LNameEditKeyPress(Sender: TObject; var Key: Char);
402begin
403 Key := Uppercase(Key)[1];
404 if Key in ['0'..'9',','] then Key := #0
405end;
406//------------------------------------------------------------------------
407procedure TfrmPtAdd.FNameEditKeyPress(Sender: TObject; var Key: Char);
408begin
409 Key := Uppercase(Key)[1];
410 if Key in ['0'..'9'] then Key := #0
411end;
412//------------------------------------------------------------------------
413procedure TfrmPtAdd.MNameEditKeyPress(Sender: TObject; var Key: Char);
414begin
415 Key := Uppercase(Key)[1];
416 if Key in ['0'..'9'] then Key := #0
417end;
418//------------------------------------------------------------------------
419procedure TfrmPtAdd.SuffixEditKeyPress(Sender: TObject; var Key: Char);
420begin
421 if Key in ['0'..'9'] then Key := #0
422end;
423//------------------------------------------------------------------------
424procedure TfrmPtAdd.SexComboBoxKeyPress(Sender: TObject; var Key: Char);
425begin
426 Key := Uppercase(Key)[1];
427 if Key = 'M' then begin
428 SexComboBox.Text := 'MALE';
429 Key := #0;
430 end else if Key = 'F' then begin
431 SexComboBox.Text := 'FEMALE';
432 Key := #0;
433 end else if Key = #8 then begin
434 SexComboBox.Text := '';
435 Key := #0;
436 end else Key := #0;
437end;
438//------------------------------------------------------------------------
439procedure TfrmPtAdd.PtTypeComboBoxKeyPress(Sender: TObject; var Key: Char);
440begin
441 Key := #0;
442end;
443//------------------------------------------------------------------------
444procedure TfrmPtAdd.PostInfo(ThisPatientInfo : TPatientInfo);
445var tempResult: integer;
446
447 procedure CheckPost(Title, Value : string);
448 begin
449 if Value <> '' then RPCBrokerV.Param[0].Mult['"'+Title+'"'] := Value;
450 end;
451
452begin
453 if MessageDlg('Add New Patient? (Can Not Be Undone)',
454 mtConfirmation, [mbYes, mbNo],0) = mrNo then exit;
455
456 RPCBrokerV.remoteprocedure := 'TMG ADD PATIENT';
457
458 RPCBrokerV.Param[0].PType := list;
459 with ThisPatientInfo do begin
460 CombinedName := LName + ',' + FName;
461 If MName <> '' then CombinedName := CombinedName + ' ' + MName;
462 If Suffix <> '' then CombinedName := CombinedName + ' ' + Suffix;
463 CheckPost('COMBINED_NAME',CombinedName);
464 CheckPost('DOB',DOB);
465 CheckPost('SEX',Sex);
466 CheckPost('SS_NUM',SSNum);
467 //CheckPost('Veteran',Veteran);
468 //CheckPost('PtType',PtType);
469
470 RPCBrokerV.Call;
471 tempResult := strtoint(piece(RPCBrokerV.Results.Strings[0],'^',1));
472 DFN := tempResult;
473 if tempResult > 0 then begin
474 //MessageDlg('Patient successfully added',mtInformation,[mbOK],0);
475 end else if tempResult = 0 then begin
476 MessageDlg('Patient already exists.',mtError,[mbOK],0);
477 DFN := strtoint(piece(RPCBrokerV.Results.Strings[0],'^',2));
478 end else begin
479 MessageDlg(RPCBrokerV.Results.Strings[0],mtError,[mbOK],0);
480 end;
481 end;
482end;
483//------------------------------------------------------------------------
484procedure TfrmPtAdd.FormDestroy(Sender: TObject);
485begin
486 ThisPatientInfo.Destroy;
487end;
488//------------------------------------------------------------------------
489procedure TfrmPtAdd.CreatePSSN();
490var
491 i: integer;
492 tempPseudo: string;
493 Init : array [1..3] of char;
494 code : char;
495 Month,Day,Year: string;
496
497begin
498 for i := 1 to 3 do Init[i]:=' ';
499 if ThisPatientInfo.FName<>'' then Init[1] := UpperCase(ThisPatientInfo.FName)[1];
500 if ThisPatientInfo.MName<>'' then Init[2] := UpperCase(ThisPatientInfo.MName)[1];
501 if ThisPatientInfo.LName<>'' then Init[3] := UpperCase(ThisPatientInfo.LName)[1];
502
503 tempPseudo := '';
504 for i := 1 to 3 do begin
505 if Init[i] in ['A','B','C'] then code := '1'
506 else if Init[i] in ['D','E','F'] then code := '2'
507 else if Init[i] in ['G','H','I'] then code := '3'
508 else if Init[i] in ['J','K','L'] then code := '4'
509 else if Init[i] in ['M','N','O'] then code := '5'
510 else if Init[i] in ['P','Q','R'] then code := '6'
511 else if Init[i] in ['S','T','U'] then code := '7'
512 else if Init[i] in ['V','W','X'] then code := '8'
513 else if Init[i] in ['Y','Z'] then code := '9'
514 else if Init[i] in [' '] then code := '0'
515 else code := '0';
516 tempPseudo := tempPseudo + code;
517 end;
518
519 Month := piece(ThisPatientInfo.DOB,'/',1);
520 Day := piece(ThisPatientInfo.DOB,'/',2);
521 Year := piece(ThisPatientInfo.DOB,'/',3);
522 tempPseudo := tempPseudo + Month + Day + Year + 'P';
523 ThisPatientInfo.SSNum := tempPseudo;
524 SSNumEdit.Text := ThisPatientInfo.SSNum;
525 SSNumEditExit(nil);
526end;
527
528procedure TfrmPtAdd.DOBEditExit(Sender: TObject);
529var
530 s,s2: string;
531 i:integer; boolInvalid: boolean;
532begin
533 boolInvalid := False;
534 s2 := '';
535 For i:=1 to 3 do begin
536 s := piece(DobEdit.Text,'/',i);
537 if ((i = 3) and (length(s) = 4)) then s := rightstr(s,2);
538 if length(s) = 1 then s := '0' + s;
539 if s2 <> '' then s2 := s2 + '/';
540 s2 := s2 + s;
541 if length(s) <> 2 then boolInvalid := True;
542 end;
543
544 if (boolInvalid = True) and (DOBEdit.Text<>'') then begin
545 messagedlg('DOB format is invalid. Please enter it in mm/dd/yy format.',mtError,[mbOK],0);
546 DOBEdit.text := '';
547 end else begin
548 DOBEdit.text := s2;
549 end;
550end;
551
552procedure TfrmPtAdd.SSNHelpBtnClick(Sender: TObject);
553begin
554 if MessageDlg('If Soc. Sec. Number (SSN) is unknown, a "Pseudo" SSN may be used.'+#10+#13+
555 'Create a Pseudo-SSN For this Patient?',
556 mtConfirmation, [mbYes, mbNo],0) = mrYes then begin
557 CreatePSSN;
558 end else begin
559 SSNumEdit.Text := '';
560 end;
561end;
562
563end.
564
Note: See TracBrowser for help on using the repository browser.