source: cprs/branches/tmg-cprs/CPRS-Chart/TMG_Extra/HTMLEdit/fPtAdd.pas@ 1806

Last change on this file since 1806 was 801, checked in by Kevin Toppenberg, 15 years ago

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