| 1 | unit fPCEProvider; | 
|---|
| 2 |  | 
|---|
| 3 | interface | 
|---|
| 4 |  | 
|---|
| 5 | uses | 
|---|
| 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, | 
|---|
| 7 | StdCtrls, ORCtrls, ExtCtrls, uPCE, ORFn, fBase508Form, | 
|---|
| 8 | VA508AccessibilityManager; | 
|---|
| 9 |  | 
|---|
| 10 | type | 
|---|
| 11 | TfrmPCEProvider = class(TfrmBase508Form) | 
|---|
| 12 | cboPrimary: TORComboBox; | 
|---|
| 13 | lblMsg: TMemo; | 
|---|
| 14 | btnYes: TButton; | 
|---|
| 15 | btnNo: TButton; | 
|---|
| 16 | btnSelect: TButton; | 
|---|
| 17 | Spacer1: TLabel; | 
|---|
| 18 | procedure cboPrimaryNeedData(Sender: TObject; const StartFrom: String; | 
|---|
| 19 | Direction, InsertAt: Integer); | 
|---|
| 20 | procedure cboPrimaryChange(Sender: TObject); | 
|---|
| 21 | procedure FormCreate(Sender: TObject); | 
|---|
| 22 | procedure btnSelectClick(Sender: TObject); | 
|---|
| 23 | private | 
|---|
| 24 | FPCEData: TPCEData; | 
|---|
| 25 | FUseDefault: boolean; | 
|---|
| 26 | FIEN: array[boolean] of Int64; | 
|---|
| 27 | FName: array[boolean] of string; | 
|---|
| 28 | public | 
|---|
| 29 | procedure AskUser(ForceSelect: boolean); | 
|---|
| 30 | end; | 
|---|
| 31 |  | 
|---|
| 32 | function NoPrimaryPCEProvider(AProviders: TPCEProviderList; PCEData: TPCEData): boolean; | 
|---|
| 33 |  | 
|---|
| 34 | implementation | 
|---|
| 35 |  | 
|---|
| 36 | uses rCore, uCore, rTIU, rPCE; | 
|---|
| 37 |  | 
|---|
| 38 | {$R *.DFM} | 
|---|
| 39 |  | 
|---|
| 40 | const | 
|---|
| 41 | AreYouStr = 'Are You, '; | 
|---|
| 42 | PEPStr2 = ' the Primary Provider for this Encounter'; | 
|---|
| 43 | PEPStr = PEPStr2 + '?'; | 
|---|
| 44 | IsStr = 'Is '; | 
|---|
| 45 | SelectStr = 'Please Select' + PEPStr2 + '.'; | 
|---|
| 46 |  | 
|---|
| 47 | function NoPrimaryPCEProvider(AProviders: TPCEProviderList; PCEData: TPCEData): boolean; | 
|---|
| 48 | var | 
|---|
| 49 | frmPCEProvider: TfrmPCEProvider; | 
|---|
| 50 | idx: integer; | 
|---|
| 51 | b: boolean; | 
|---|
| 52 | X: string; | 
|---|
| 53 | mr: TModalResult; | 
|---|
| 54 |  | 
|---|
| 55 | begin | 
|---|
| 56 | if(AProviders.PrimaryIdx < 0) then | 
|---|
| 57 | SetDefaultProvider(AProviders, PCEData); | 
|---|
| 58 | if(AProviders.PrimaryIdx < 0) then | 
|---|
| 59 | begin | 
|---|
| 60 | frmPCEProvider := TfrmPCEProvider.Create(Application); | 
|---|
| 61 | try | 
|---|
| 62 | with frmPCEProvider do | 
|---|
| 63 | begin | 
|---|
| 64 | FPCEData := PCEData; | 
|---|
| 65 | for b := FALSE to TRUE do | 
|---|
| 66 | begin | 
|---|
| 67 | FIEN[b] := AProviders.PendingIEN(b); | 
|---|
| 68 | FName[b] := AProviders.PendingNAME(b); | 
|---|
| 69 | end; | 
|---|
| 70 | if(FIEN[TRUE] = 0) and (FIEN[FALSE] = 0) then | 
|---|
| 71 | begin | 
|---|
| 72 | AskUser(TRUE); | 
|---|
| 73 | mr := ModalResult; | 
|---|
| 74 | end | 
|---|
| 75 | else | 
|---|
| 76 | begin | 
|---|
| 77 | FUseDefault := TRUE; | 
|---|
| 78 | AskUser(FALSE); | 
|---|
| 79 | mr := ModalResult; | 
|---|
| 80 | if((mr in [mrAbort, mrNo]) and (FIEN[TRUE] <> FIEN[FALSE])) then | 
|---|
| 81 | begin | 
|---|
| 82 | FUseDefault := FALSE; | 
|---|
| 83 | AskUser(FALSE); | 
|---|
| 84 | mr := ModalResult; | 
|---|
| 85 | end; | 
|---|
| 86 | end; | 
|---|
| 87 | if (mr = mrYes) then | 
|---|
| 88 | begin | 
|---|
| 89 | AProviders.AddProvider(IntToStr(FIEN[FUseDefault]), FName[FUseDefault], TRUE); | 
|---|
| 90 | end | 
|---|
| 91 | else | 
|---|
| 92 | if (mr = mrOK) then | 
|---|
| 93 | begin | 
|---|
| 94 | idx := cboPrimary.ItemIndex; | 
|---|
| 95 | if(idx >= 0) then | 
|---|
| 96 | begin | 
|---|
| 97 | X := frmPCEProvider.cboPrimary.Items[idx]; | 
|---|
| 98 | AProviders.AddProvider(Piece(X, U, 1), Piece(X, U, 2), TRUE); | 
|---|
| 99 | end; | 
|---|
| 100 | end; | 
|---|
| 101 | end; | 
|---|
| 102 | finally | 
|---|
| 103 | frmPCEProvider.Free; | 
|---|
| 104 | end; | 
|---|
| 105 | Result := (AProviders.PrimaryIdx < 0); | 
|---|
| 106 | end | 
|---|
| 107 | else | 
|---|
| 108 | Result := FALSE; | 
|---|
| 109 | end; | 
|---|
| 110 |  | 
|---|
| 111 | { TfrmPCEProvider } | 
|---|
| 112 |  | 
|---|
| 113 | procedure TfrmPCEProvider.cboPrimaryNeedData(Sender: TObject; | 
|---|
| 114 | const StartFrom: String; Direction, InsertAt: Integer); | 
|---|
| 115 | begin | 
|---|
| 116 | if(FPCEData.VisitCategory = 'E') then | 
|---|
| 117 | cboPrimary.ForDataUse(SubSetOfPersons(StartFrom, Direction)) | 
|---|
| 118 | else | 
|---|
| 119 | cboPrimary.ForDataUse(SubSetOfUsersWithClass(StartFrom, Direction, | 
|---|
| 120 | FloatToStr(FPCEData.PersonClassDate))); | 
|---|
| 121 | end; | 
|---|
| 122 |  | 
|---|
| 123 | procedure TfrmPCEProvider.cboPrimaryChange(Sender: TObject); | 
|---|
| 124 | var | 
|---|
| 125 | txt: string; | 
|---|
| 126 |  | 
|---|
| 127 | begin | 
|---|
| 128 | if(cboPrimary.ItemIEN <> 0) and (FPCEData.VisitCategory <> 'E') then | 
|---|
| 129 | begin | 
|---|
| 130 | txt := InvalidPCEProviderTxt(cboPrimary.ItemIEN, FPCEData.PersonClassDate); | 
|---|
| 131 | if(txt <> '') then | 
|---|
| 132 | begin | 
|---|
| 133 | InfoBox(cboPrimary.DisplayText[cboPrimary.ItemIndex] + txt, TX_BAD_PROV, MB_OK); | 
|---|
| 134 | cboPrimary.ItemIndex := -1; | 
|---|
| 135 | end; | 
|---|
| 136 | end; | 
|---|
| 137 | end; | 
|---|
| 138 |  | 
|---|
| 139 | procedure TfrmPCEProvider.FormCreate(Sender: TObject); | 
|---|
| 140 | begin | 
|---|
| 141 | ResizeAnchoredFormToFont(self); | 
|---|
| 142 | ClientHeight := cboPrimary.Top; | 
|---|
| 143 | end; | 
|---|
| 144 |  | 
|---|
| 145 | procedure TfrmPCEProvider.btnSelectClick(Sender: TObject); | 
|---|
| 146 | begin | 
|---|
| 147 | ClientHeight := cboPrimary.Top + cboPrimary.Height + 5; | 
|---|
| 148 | cboPrimary.Visible := TRUE; | 
|---|
| 149 | btnSelect.Visible := FALSE; | 
|---|
| 150 | btnYes.Caption := '&OK'; | 
|---|
| 151 | btnYes.ModalResult := mrOK; | 
|---|
| 152 | btnNo.Caption := '&Cancel'; | 
|---|
| 153 | btnNo.ModalResult := mrCancel; | 
|---|
| 154 | lblMsg.Text := SelectStr; | 
|---|
| 155 | cboPrimary.Caption := lblMsg.Text; | 
|---|
| 156 | cboPrimary.InitLongList(User.Name); | 
|---|
| 157 | end; | 
|---|
| 158 |  | 
|---|
| 159 | procedure TfrmPCEProvider.AskUser(ForceSelect: boolean); | 
|---|
| 160 | var | 
|---|
| 161 | msg: string; | 
|---|
| 162 |  | 
|---|
| 163 | begin | 
|---|
| 164 | if(ForceSelect) then | 
|---|
| 165 | begin | 
|---|
| 166 | btnSelectClick(Self); | 
|---|
| 167 | end | 
|---|
| 168 | else | 
|---|
| 169 | begin | 
|---|
| 170 | if(FIEN[FUseDefault] = 0) then | 
|---|
| 171 | begin | 
|---|
| 172 | ModalResult := mrAbort; | 
|---|
| 173 | exit; | 
|---|
| 174 | end | 
|---|
| 175 | else | 
|---|
| 176 | begin | 
|---|
| 177 | if(FIEN[FUseDefault] = User.DUZ) then | 
|---|
| 178 | msg := AreYouStr + FName[FUseDefault] + ',' + PEPStr | 
|---|
| 179 | else | 
|---|
| 180 | msg := IsStr + FName[FUseDefault] + PEPStr; | 
|---|
| 181 | end; | 
|---|
| 182 | lblMsg.text := msg; | 
|---|
| 183 | cboPrimary.Caption := lblMsg.text; | 
|---|
| 184 | end; | 
|---|
| 185 | ShowModal; | 
|---|
| 186 | end; | 
|---|
| 187 |  | 
|---|
| 188 | end. | 
|---|