Produced by Araxis Merge on 5/13/2019 2:40:13 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\MPDU\Code\EPCS-master-20181214\EPCS-master | fMain.pas | Wed Nov 28 18:08:18 2018 UTC |
| 2 | C:\AraxisMergeCompare\Pri_re\MPDU\MPDU\Code\EPCS-master-20181214\EPCS-master | fMain.pas | Tue May 7 18:14:12 2019 UTC |
| Description | Between Files 1 and 2 |
|
|---|---|---|
| Text Blocks | Lines | |
| Unchanged | 2 | 3826 |
| Changed | 1 | 2 |
| 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 fMain ; | |
| 2 | ||
| 3 | interface | |
| 4 | ||
| 5 | uses | |
| 6 | System.V ariants, | |
| 7 | System.C haracter, | |
| 8 | System.C lasses, | |
| 9 | System.S ysUtils, | |
| 10 | System.A ctions, | |
| 11 | System.S trUtils, | |
| 12 | System.U ITypes, | |
| 13 | Vcl.Grap hics, | |
| 14 | Vcl.Cont rols, | |
| 15 | Vcl.Form s, | |
| 16 | Vcl.Dial ogs, | |
| 17 | Vcl.StdC trls, | |
| 18 | Vcl.ExtC trls, | |
| 19 | Vcl.ComC trls, | |
| 20 | Vcl.Menu s, | |
| 21 | Vcl.Actn List, | |
| 22 | Winapi.M essages, | |
| 23 | Winapi.W indows, | |
| 24 | Diaccess , | |
| 25 | Fmcntrls , | |
| 26 | Fmcmpnts , | |
| 27 | Fmlookup Plus, | |
| 28 | Trpcb, | |
| 29 | oPCSPres criber, Vc l.StdActns , File200; | |
| 30 | ||
| 31 | type | |
| 32 | TfrmMain = class(T Form) | |
| 33 | pnlTop : TPanel; | |
| 34 | pnlMai n: TPanel; | |
| 35 | edtSer ver: TEdit ; | |
| 36 | edtFac ilityDEANu m: TEdit; | |
| 37 | edtPor t: TEdit; | |
| 38 | lblSer ver: TLabe l; | |
| 39 | lblPor tNumber: T Label; | |
| 40 | lblDea Expiration Date: TLab el; | |
| 41 | lblDEA Number: TL abel; | |
| 42 | lblDet oxMaintNum ber: TLabe l; | |
| 43 | lblVAN umber: TLa bel; | |
| 44 | lblSAN Example: T Label; | |
| 45 | lblFac ilityDEANu mber: TLab el; | |
| 46 | lblAcc essCode: T Label; | |
| 47 | lblVer ifyCode: T Label; | |
| 48 | lblDis Usered: TL abel; | |
| 49 | lblTer minationDa te: TLabel ; | |
| 50 | lblSch edules: TL abel; | |
| 51 | btnGet ServerInfo : TButton; | |
| 52 | btnCon nect: TBut ton; | |
| 53 | btnExi t: TButton ; | |
| 54 | btnSel ectPrescri ber: TButt on; | |
| 55 | btnUpd ate: TButt on; | |
| 56 | fmFind erPrescrib er: TFMFin der; | |
| 57 | fmList erNewPerso nDivision: TFMLister ; | |
| 58 | fmGets Prescriber : TFMGets; | |
| 59 | fmGets ActiveUser : TFMGets; | |
| 60 | fmFile r: TFMFile r; | |
| 61 | fmVali dator: TFM Validator; | |
| 62 | fmList erNewPerso n: TFMList er; | |
| 63 | fmlblS ubjectAlte rnativeNam e: TFMLabe l; | |
| 64 | fmedtA ltName: TF MEdit; | |
| 65 | fmedtA ccessCode: TFMEdit; | |
| 66 | fmedtV erifyCode: TFMEdit; | |
| 67 | fmedtD ISUSERed: TFMEdit; | |
| 68 | fmedtT ermination Date: TFME dit; | |
| 69 | fmedtV ANumber: T FMEdit; | |
| 70 | fmedtP roviderNam e: TFMEdit ; | |
| 71 | fmedtD etoxMaintN umber: TFM Edit; | |
| 72 | fmedtD eaExpirati onDate: TF MEdit; | |
| 73 | fmcbxS cheduleV: TFMCheckBo x; | |
| 74 | fmcbxS cheduleIV: TFMCheckB ox; | |
| 75 | fmcbxS cheduleIIN onNarcotic : TFMCheck Box; | |
| 76 | fmcbxS cheduleIIN arcotic: T FMCheckBox ; | |
| 77 | fmcbxS cheduleIII NonNarcoti c: TFMChec kBox; | |
| 78 | fmcbxS cheduleIII Narcotic: TFMCheckBo x; | |
| 79 | fmcbxA uthorizedT oWriteOrde rs: TFMChe ckBox; | |
| 80 | RPCBro ker: TRPCB roker; | |
| 81 | mmMain : TMainMen u; | |
| 82 | mmMain File: TMen uItem; | |
| 83 | mmMain FileExit: TMenuItem; | |
| 84 | mmMain Help: TMen uItem; | |
| 85 | mmMain HelpAbout: TMenuItem ; | |
| 86 | memUti lity: TMem o; | |
| 87 | acList : TActionL ist; | |
| 88 | acAbou t: TAction ; | |
| 89 | acConn ectDisconn ect: TActi on; | |
| 90 | acGetS erverInfo: TAction; | |
| 91 | acExit : TAction; | |
| 92 | acSele ctPrescrib er: TActio n; | |
| 93 | acClea rMainPanel : TAction; | |
| 94 | acUpda te: TActio n; | |
| 95 | acAllS chedules: TAction; | |
| 96 | bvlCon trolPanel: TBevel; | |
| 97 | bvlSch edules: TB evel; | |
| 98 | cbxAll Schedules: TCheckBox ; | |
| 99 | cboDea Number: TC omboBox; | |
| 100 | fmcbxU seInpatien t: TFMChec kBox; | |
| 101 | fmedtD eaNumber: TFMEdit; | |
| 102 | lblCur renDEA: TL abel; | |
| 103 | fmVali dator8991: TFMValida tor; | |
| 104 | fmFile r8991: TFM Filer; | |
| 105 | fmGets Prescriber 8991: TFMG ets; | |
| 106 | Label1 : TLabel; | |
| 107 | pnlDOJ 1: TPanel; | |
| 108 | lblDOJ 1: TLabel; | |
| 109 | lblDet oxMaintNum berDOJ: TL abel; | |
| 110 | lblDea Expiration DateDOJ: T Label; | |
| 111 | Panel1 : TPanel; | |
| 112 | lblDOJ 2: TLabel; | |
| 113 | chkSch eduleIINar coticDOJ: TCheckBox; | |
| 114 | chkSch eduleIINon NarcoticDO J: TCheckB ox; | |
| 115 | chkSch eduleIIINa rcoticDOJ: TCheckBox ; | |
| 116 | chkSch eduleIIINo nNarcoticD OJ: TCheck Box; | |
| 117 | chkSch eduleIVDOJ : TCheckBo x; | |
| 118 | chkSch eduleVDOJ: TCheckBox ; | |
| 119 | btnCop y: TButton ; | |
| 120 | btnRem ove: TButt on; | |
| 121 | lblInp atientWarn ing: TLabe l; | |
| 122 | EditDe lete1: TEd itDelete; | |
| 123 | lblPro viderNameD OJ: TLabel ; | |
| 124 | btnAdd : TButton; | |
| 125 | lblDEA Suffix: TL abel; | |
| 126 | edtDEA Suffix: TE dit; | |
| 127 | btnEdi t: TButton ; | |
| 128 | fmlblP roviderTyp e: TFMLabe l; | |
| 129 | ||
| 130 | proced ure FormCr eate(Sende r: TObject ); | |
| 131 | proced ure FormCl oseQuery(S ender: TOb ject; var CanClose: Boolean); | |
| 132 | ||
| 133 | proced ure acConn ectDisconn ectExecute (Sender: T Object); | |
| 134 | proced ure acAbou tExecute(S ender: TOb ject); | |
| 135 | proced ure acGetS erverInfoE xecute(Sen der: TObje ct); | |
| 136 | proced ure acExit Execute(Se nder: TObj ect); | |
| 137 | proced ure acSele ctPrescrib erExecute( Sender: TO bject); | |
| 138 | proced ure acClea rMainPanel Execute(Se nder: TObj ect); | |
| 139 | proced ure acUpda teExecute( Sender: TO bject); | |
| 140 | proced ure acAllS chedulesEx ecute(Send er: TObjec t); | |
| 141 | ||
| 142 | proced ure fmedtA ltNameExit (Sender: T Object); | |
| 143 | proced ure fmcbxS cheduleCli ck(Sender: TObject); | |
| 144 | proced ure cboDea NumberChan ge(Sender: TObject); | |
| 145 | proced ure fmcbxU seInpatien tClick(Sen der: TObje ct); | |
| 146 | proced ure btnRem oveClick(S ender: TOb ject); | |
| 147 | proced ure btnCop yClick(Sen der: TObje ct); | |
| 148 | proced ure btnAdd Click(Send er: TObjec t); | |
| 149 | proced ure UpperC aseChange( Sender: TO bject); | |
| 150 | ||
| 151 | proced ure CheckD etoxNumber (Sender: T Object; va r Key: Wor d; | |
| 152 | Shif t: TShiftS tate); | |
| 153 | ||
| 154 | proced ure btnEdi tClick(Sen der: TObje ct); | |
| 155 | private | |
| 156 | fCurre ntPrescrib er: TPCSPr escriber; | |
| 157 | foPres criberDEAL ist: TStri ngList; | |
| 158 | flVali dateOnClic kUseInpati entOrder: Boolean; | |
| 159 | fcCopy DOJInforma tion: Stri ng; | |
| 160 | ||
| 161 | proced ure CheckI npatientWa rning(); | |
| 162 | proced ure update ControlsOn Select(tlA ddRequest: Boolean; tnIndex: I nteger); | |
| 163 | functi on getCurr entInforma tion(tnInd ex: Intege r; tnConst : Integer) : string; | |
| 164 | functi on FMDateT ime2TDateT ime(aValue : string): TDateTime ; | |
| 165 | functi on IsActiv eUser: Boo lean; | |
| 166 | functi on HoldsVi stAKey(AKe yName: str ing): Bool ean; | |
| 167 | functi on Display Warning: B oolean; | |
| 168 | functi on EditVAN umber: Boo lean; | |
| 169 | ||
| 170 | functi on GetFaci lityVANum( IENS: stri ng): strin g; | |
| 171 | functi on GetValu eFromVistA (InputStr: string): string; | |
| 172 | ||
| 173 | proced ure Applic ationExcep tion(Sende r: TObject ; E: Excep tion); | |
| 174 | proced ure Initia lizeData(a PCSPrescri ber: TPCSP rescriber; tcDUZ: st ring); | |
| 175 | proced ure Update DEAList(tc DUZ: Strin g); | |
| 176 | proced ure Update DEAComboBo x(tcDUZ: S tring); | |
| 177 | proced ure Update RCPVariabl es(); | |
| 178 | proced ure Update DOJControl s(tlAddReq uest: Bool ean; tcDEA : String; | |
| 179 | var tcInfo: St ring; var tcError: S tring); | |
| 180 | functi on Decipho rDOJ(tcDOJ : String; tnConst: I nteger): s tring; | |
| 181 | functi on BuildDO JAddress(t cDOJ: Stri ng): strin g; | |
| 182 | proced ure BlankD OJFields() ; | |
| 183 | ||
| 184 | proced ure setEna ble(toEdit : TEdit; t lEnable: B oolean); | |
| 185 | functi on GetLast Name(tcNam e: String) : String; | |
| 186 | functi on CheckDE ADuplicate s(): Boole an; | |
| 187 | functi on BuildAd dString(): String; | |
| 188 | functi on Decipho rCheckBox( toCheckBox : TCheckBo x): String ; | |
| 189 | functi on CountVa lidDEANumb ers(): Int eger; | |
| 190 | functi on CheckDE AFormat(tc DEA: Strin g): Boolea n; | |
| 191 | end; | |
| 192 | ||
| 193 | const | |
| 194 | CRLF = # 13 + #10; | |
| 195 | ||
| 196 | ADD_DEA = '<Add ne w DEA #>'; | |
| 197 | DEA = 1; | |
| 198 | SUFFIX = 2; | |
| 199 | STATE = 3; | |
| 200 | DETOX = 4; | |
| 201 | EXPIRATI ON = 5; | |
| 202 | NPIENS = 6; | |
| 203 | DNIENS = 7; // IEN S number t o use | |
| 204 | SCHEDULE _II_NARCOT IC = 8; | |
| 205 | SCHEDULE _II_NON_NA RCOTIC = 9 ; | |
| 206 | SCHEDULE _III_NARCO TIC = 10; | |
| 207 | SCHEDULE _III_NON_N ARCOTIC = 11; | |
| 208 | SCHEDULE _IV = 12; | |
| 209 | SCHEDULE _V = 13; | |
| 210 | INPATIEN T = 14; | |
| 211 | ||
| 212 | DOJ_PROV IDER_NAME = 1; | |
| 213 | DOJ_ADDR ESS1 = 2; | |
| 214 | DOJ_ADDR ESS2 = 3; | |
| 215 | DOJ_ADDR ESS3 = 4; | |
| 216 | DOJ_CITY = 5; | |
| 217 | DOJ_STAT E = 6; | |
| 218 | DOJ_STAT E_POINTER = 7; | |
| 219 | DOJ_ZIP_ CODE = 8; | |
| 220 | DOJ_ACTI VITY_CODE = 9; | |
| 221 | DOJ_TYPE = 10; | |
| 222 | DOJ_DEA_ NUMBER = 1 1; | |
| 223 | DOJ_EXPI RATION_DAT E = 12; | |
| 224 | DOJ_PROC ESSED_DATE = 13; | |
| 225 | DOJ_DETO X_NUMBER = 14; | |
| 226 | DOJ_SCHD EULE_II_NA RCOTIC = 1 5; | |
| 227 | DOJ_SCHE DULE_II_NO N_NARCOTIC = 16; | |
| 228 | DOJ_SCHE DULE_III_N ARCOTIC = 17; | |
| 229 | DOJ_SCHE DULE_III_N ON_NARCOTI C = 18; | |
| 230 | DOJ_SCHE DULE_IV = 19; | |
| 231 | DOJ_SCHE DULE_V = 2 0; | |
| 232 | ||
| 233 | DOJ_EMPT Y = '<empt y>'; | |
| 234 | DOJ_INST ITUTION = 'INSTITUTI ONAL'; | |
| 235 | ||
| 236 | DEA_SUFF IX_MIN = 3 ; | |
| 237 | DEA_SUFF IX_MAX = 1 0; | |
| 238 | ||
| 239 | // From the help d ocumentati on on IENS . | |
| 240 | IENS_ADD = '+1'; | |
| 241 | ||
| 242 | PROVIDER _TYPES = ' ,FULL TIME ,PART TIME ,C & A,FEE BASIS,HOU SE STAFF,' ; | |
| 243 | PROVIDER _TYPES_VA = ',FULL T IME,PART T IME,HOUSE STAFF,'; | |
| 244 | ||
| 245 | var | |
| 246 | frmMain: TfrmMain; | |
| 247 | fmlkupPr escriber: TFMLookUpP lus; | |
| 248 | ||
| 249 | implementa tion | |
| 250 | ||
| 251 | uses | |
| 252 | VAUtils, | |
| 253 | fWarning , | |
| 254 | fVistAAb out, | |
| 255 | RpcConf1 , | |
| 256 | MFunStr, | |
| 257 | oPKIEncr yption; | |
| 258 | ||
| 259 | {$R *.dfm} | |
| 260 | ||
| 261 | procedure TfrmMain.F ormCreate( Sender: TO bject); | |
| 262 | var | |
| 263 | i: Integ er; | |
| 264 | begin | |
| 265 | flValida teOnClickU seInpatien tOrder := False; | |
| 266 | ||
| 267 | Font := Screen.Ico nFont; | |
| 268 | for i := 0 to Para mCount do | |
| 269 | if (Po s('P=', Up perCase(Pa ramStr(i)) ) = 1) the n | |
| 270 | edtP ort.Text : = Copy(Par amStr(i), 3, Length( ParamStr(i ))) | |
| 271 | else i f (Pos('S= ', UpperCa se(ParamSt r(i))) = 1 ) then | |
| 272 | edtS erver.Text := Copy(P aramStr(i) , 3, Lengt h(ParamStr (i))); | |
| 273 | ||
| 274 | Self.Sho wHint := T rue; | |
| 275 | Applicat ion.OnExce ption := A pplication Exception; | |
| 276 | Applicat ion.ShowHi nt := True ; | |
| 277 | pnlTop.D oubleBuffe red := Tru e; | |
| 278 | pnlMain. DoubleBuff ered := Tr ue; | |
| 279 | acClearM ainPanel.E xecute; | |
| 280 | ||
| 281 | fmlkupPr escriber : = TFMLookU pPlus.Crea te(frmMain ); | |
| 282 | fmlkupPr escriber.F MLister := fmListerN ewPerson; | |
| 283 | fmlkupPr escriber.H elpContext := 0; | |
| 284 | ||
| 285 | end; | |
| 286 | ||
| 287 | procedure TfrmMain.F ormCloseQu ery(Sender : TObject; var CanCl ose: Boole an); | |
| 288 | var | |
| 289 | lcMessag e: String; | |
| 290 | begin | |
| 291 | if (lblI npatientWa rning.Visi ble) then | |
| 292 | begin | |
| 293 | lcMess age := Tri m(lblInpat ientWarnin g.Caption) ; | |
| 294 | ||
| 295 | ShowMs g(lcMessag e, smiErro r, smbOK); | |
| 296 | CanClo se := Fals e; | |
| 297 | end | |
| 298 | else | |
| 299 | begin | |
| 300 | FreeAn dNil(fCurr entPrescri ber); | |
| 301 | CanClo se := True ; | |
| 302 | end; | |
| 303 | end; | |
| 304 | ||
| 305 | procedure TfrmMain.a cAboutExec ute(Sender : TObject) ; | |
| 306 | begin | |
| 307 | TfrmVist AAbout.Exe cute; | |
| 308 | end; | |
| 309 | ||
| 310 | procedure TfrmMain.a cAllSchedu lesExecute (Sender: T Object); | |
| 311 | ||
| 312 | procedur e DoCheck( aFMcbx: TF MCheckBox) ; | |
| 313 | begin | |
| 314 | if not aFMcbx.Ch ecked then | |
| 315 | begin | |
| 316 | aFMc bx.Checked := True; | |
| 317 | aFMc bx.AutoVal idate; | |
| 318 | end; | |
| 319 | end; | |
| 320 | ||
| 321 | begin | |
| 322 | // Send these item s thru the above met hod so we don't over check and uncheck t hem | |
| 323 | if cbxAl lSchedules .Checked t hen | |
| 324 | begin | |
| 325 | DoChec k(fmcbxSch eduleV); | |
| 326 | DoChec k(fmcbxSch eduleIV); | |
| 327 | DoChec k(fmcbxSch eduleIINon Narcotic); | |
| 328 | DoChec k(fmcbxSch eduleIINar cotic); | |
| 329 | DoChec k(fmcbxSch eduleIIINo nNarcotic) ; | |
| 330 | DoChec k(fmcbxSch eduleIIINa rcotic); | |
| 331 | end; | |
| 332 | end; | |
| 333 | ||
| 334 | procedure TfrmMain.a cClearMain PanelExecu te(Sender: TObject); | |
| 335 | var | |
| 336 | i: Integ er; | |
| 337 | CurrObje ct: TContr ol; | |
| 338 | begin | |
| 339 | for i := 0 to pnlM ain.Contro lCount - 1 do | |
| 340 | begin | |
| 341 | CurrOb ject := pn lMain.Cont rols[i]; | |
| 342 | if Cur rObject is TFMCheckB ox then | |
| 343 | TFMC heckBox(Cu rrObject). Checked := False | |
| 344 | else i f CurrObje ct is TFME dit then | |
| 345 | TFME dit(CurrOb ject).Text := ''; | |
| 346 | ||
| 347 | // If no prescri ber or Bro ker connec tion, disa ble the co ntrol as w ell | |
| 348 | if (Cu rrObject i s TControl ) then | |
| 349 | begin | |
| 350 | TCon trol(CurrO bject).Ena bled := | |
| 351 | (A ssigned(fC urrentPres criber) an d RPCBroke r.Connecte d); | |
| 352 | end; | |
| 353 | end; | |
| 354 | ||
| 355 | // Alway s gets cle ared manua lly here, not FM Com ponents | |
| 356 | edtFacil ityDEANum. Text := '' ; | |
| 357 | ||
| 358 | // Enabl ed depends on Broker Status | |
| 359 | acSelect Prescriber .Enabled : = RPCBroke r.Connecte d; | |
| 360 | btnSelec tPrescribe r.Enabled := RPCBrok er.Connect ed; | |
| 361 | end; | |
| 362 | ||
| 363 | procedure TfrmMain.a cConnectDi sconnectEx ecute(Send er: TObjec t); | |
| 364 | var | |
| 365 | aPKIEncr yptionEngi ne: IPKIEn cryptionEn gine; | |
| 366 | aMessage : string; | |
| 367 | begin | |
| 368 | if RPCBr oker.Conne cted then | |
| 369 | begin | |
| 370 | RPCBro ker.Connec ted := Fal se; | |
| 371 | FreeAn dNil(fCurr entPrescri ber); | |
| 372 | acClea rMainPanel .Execute; | |
| 373 | acConn ectDisconn ect.Captio n := '&Con nect'; | |
| 374 | Exit; | |
| 375 | end; | |
| 376 | ||
| 377 | if ((edt Server.Tex t = '') or (edtPort. Text = '') ) then | |
| 378 | begin | |
| 379 | ShowMs g('Please select a S erver and Port combi nation bef ore trying to connec t.', | |
| 380 | 'Inf ormation', smiInfo, smbOK); | |
| 381 | Exit; | |
| 382 | end; | |
| 383 | ||
| 384 | try | |
| 385 | RPCBro ker.Server := edtSer ver.Text; | |
| 386 | RPCBro ker.Listen erPort := StrToInt(e dtPort.Tex t); | |
| 387 | ||
| 388 | RPCBro ker.ClearP arameters := True; | |
| 389 | RPCBro ker.Connec ted := Tru e; | |
| 390 | ||
| 391 | if (no t RPCBroke r.Connecte d) then | |
| 392 | rais e EPKIEncr yptionErro r.Create(D LG_8980204 2); | |
| 393 | ||
| 394 | if ((T rim(RPCBro ker.SSOiSE CID) = '') Or | |
| 395 | (Tri m(RPCBroke r.SSOiLogo nName) = ' ')) Then | |
| 396 | rais e EPKIEncr yptionErro r.Create | |
| 397 | (' This appli cation req uires 2 Fa ctor Authe ntication. You must login usin g PIV card .' | |
| 398 | + CRLF + CRL F + 'SSOiS ECID: ' + RPCBroker. SSOiSECID + CRLF + | |
| 399 | 'S SOiLogonNa me: ' + RP CBroker.SS OiLogonNam e); | |
| 400 | ||
| 401 | if not RPCBroker .CreateCon text('PSO DEA EDIT D ATA') then | |
| 402 | rais e EPKIEncr yptionErro r.Create(D LG_8980204 3); | |
| 403 | ||
| 404 | if Hol dsVistAKey ('ORES') t hen | |
| 405 | rais e EPKIEncr yptionErro r.Create(D LG_8980204 4); | |
| 406 | ||
| 407 | if (no t HoldsVis tAKey('XUE PCSEDIT')) then | |
| 408 | rais e EPKIEncr yptionErro r.Create(D LG_8980204 5); | |
| 409 | ||
| 410 | NewPKI Encryption Engine(RPC Broker, aP KIEncrypti onEngine); | |
| 411 | ||
| 412 | if not IsDigital SignatureA vailable(a PKIEncrypt ionEngine, aMessage) then | |
| 413 | rais e Exceptio n.Create(a Message) | |
| 414 | else i f VerifyPK IPin(aPKIE ncryptionE ngine) <> prOK then | |
| 415 | rais e EPKIEncr yptionErro r.Create(D LG_8980200 9); | |
| 416 | ||
| 417 | // We are connec ted and re ady to run the app | |
| 418 | acConn ectDisconn ect.Captio n := '&Dis connect'; | |
| 419 | fmVali dator.IENS := ''; | |
| 420 | fmVali dator8991. IENS := '' ; | |
| 421 | FreeAn dNil(fCurr entPrescri ber); | |
| 422 | acClea rMainPanel .Execute; | |
| 423 | except | |
| 424 | on E: Exception do | |
| 425 | begin | |
| 426 | RPCB roker.Conn ected := F alse; | |
| 427 | Show Msg('Error : ' + E.Me ssage, 'Er ror', smiE rror, smbO K); | |
| 428 | fmVa lidator.IE NS := ''; | |
| 429 | fmVa lidator899 1.IENS := ''; | |
| 430 | Free AndNil(fCu rrentPresc riber); | |
| 431 | acCl earMainPan el.Execute ; | |
| 432 | acCo nnectDisco nnect.Capt ion := '&C onnect'; | |
| 433 | end; | |
| 434 | end; | |
| 435 | end; | |
| 436 | ||
| 437 | procedure TfrmMain.a cExitExecu te(Sender: TObject); | |
| 438 | begin | |
| 439 | Close; | |
| 440 | end; | |
| 441 | ||
| 442 | procedure TfrmMain.a cGetServer InfoExecut e(Sender: TObject); | |
| 443 | var | |
| 444 | aServer: string; | |
| 445 | aPort: s tring; | |
| 446 | begin | |
| 447 | if GetSe rverInfo(a Server, aP ort) <> Mr Cancel the n | |
| 448 | begin | |
| 449 | edtSer ver.Text : = aServer; | |
| 450 | edtPor t.Text := aPort; | |
| 451 | end; | |
| 452 | end; | |
| 453 | ||
| 454 | procedure TfrmMain.a cSelectPre scriberExe cute(Sende r: TObject ); | |
| 455 | var | |
| 456 | AddRecor d: Boolean ; | |
| 457 | begin | |
| 458 | flValida teOnClickU seInpatien tOrder := False; | |
| 459 | ||
| 460 | FreeAndN il(fCurren tPrescribe r); | |
| 461 | fmValida tor.IENS : = ''; | |
| 462 | BlankDOJ Fields(); | |
| 463 | edtDEASu ffix.Text := ''; | |
| 464 | cboDeaNu mber.Items .Clear; | |
| 465 | ||
| 466 | acClearM ainPanel.E xecute; | |
| 467 | fmlkupPr escriber.A llowNew := False; | |
| 468 | ||
| 469 | if fmlku pPrescribe r.Execute( AddRecord) then | |
| 470 | try | |
| 471 | fCur rentPrescr iber := TP CSPrescrib er.Create | |
| 472 | (f mlkupPresc riber.Reco rdNumber); | |
| 473 | ||
| 474 | setE nable(edtF acilityDEA Num, False ); | |
| 475 | setE nable(fmed tVANumber, False); | |
| 476 | ||
| 477 | fmGe tsActiveUs er.IENS := fCurrentP rescriber. IENS; | |
| 478 | fmGe tsActiveUs er.GetandF ill; // I think the issue happ ens in her e! | |
| 479 | ||
| 480 | if I sActiveUse r then | |
| 481 | begi n | |
| 482 | ac ClearMainP anel.Execu te; | |
| 483 | In itializeDa ta(fCurren tPrescribe r, fmlkupP rescriber. RecordNumb er); | |
| 484 | fm Validator. IENS := fC urrentPres criber.IEN S; | |
| 485 | ||
| 486 | fl ValidateOn ClickUseIn patientOrd er := True ; | |
| 487 | bt nEdit.Enab led := Edi tVANumber; | |
| 488 | end | |
| 489 | else | |
| 490 | begi n | |
| 491 | Fr eeAndNil(f CurrentPre scriber); | |
| 492 | fm Validator. IENS := '' ; | |
| 493 | end; | |
| 494 | except | |
| 495 | on E : Exceptio n do | |
| 496 | begi n | |
| 497 | Sh owMsg(E.Me ssage, 'Er ror Loadin g Record.' , smiError , smbOK); | |
| 498 | Fr eeAndNil(f CurrentPre scriber); | |
| 499 | fm Validator. IENS := '' ; | |
| 500 | ac ClearMainP anel.Execu te; | |
| 501 | end; | |
| 502 | end | |
| 503 | else | |
| 504 | ShowMs g('No reco rd selecte d.', 'Info rmation', smiInfo, s mbOK); | |
| 505 | end; | |
| 506 | ||
| 507 | procedure TfrmMain.a cUpdateExe cute(Sende r: TObject ); | |
| 508 | var | |
| 509 | i: Integ er; | |
| 510 | aChangeL ist: TStri ngList; | |
| 511 | lcCurren tDEA: stri ng; | |
| 512 | ||
| 513 | procedur e AddTextC hange(fmed t: TFMEdit ; aOrigina lValue: st ring; | |
| 514 | tcCurr entDEA: st ring); | |
| 515 | begin | |
| 516 | if (An siCompareS tr(fmedt.F MCtrlInter nal, aOrig inalValue) <> 0) the n | |
| 517 | begin | |
| 518 | aCha ngeList.Ad d(Format(' `%s^`%s^%s ^%s^%s^%s' , [fCurren tPrescribe r.IEN, | |
| 519 | RP CBroker.Us er.DUZ, fm edt.FMFiel d, aOrigin alValue, f medt.FMCtr lInternal, | |
| 520 | tc CurrentDEA ])); | |
| 521 | ||
| 522 | Outp utDebugStr ing(Pchar( Format('`% s^`%s^%s^% s^%s^%s', | |
| 523 | [f CurrentPre scriber.IE N, RPCBrok er.User.DU Z, fmedt.F MField, | |
| 524 | aO riginalVal ue, fmedt. FMCtrlInte rnal, tcCu rrentDEA]) + chr(13) + | |
| 525 | ch r(10))); | |
| 526 | end; | |
| 527 | ||
| 528 | end; | |
| 529 | ||
| 530 | procedur e AddBoole anChange(f mcbx: TFMC heckBox; a OriginalVa lue: Boole an; | |
| 531 | tcCurr entDEA: st ring); | |
| 532 | begin | |
| 533 | if not (fmcbx.Che cked = aOr iginalValu e) then | |
| 534 | begin | |
| 535 | aCha ngeList.Ad d(Format(' `%s^`%s^%s ^%s^%s^%s' , [fCurren tPrescribe r.IEN, | |
| 536 | RP CBroker.Us er.DUZ, fm cbx.FMFiel d, BoolToS tr(aOrigin alValue, T rue), | |
| 537 | Bo olToStr(fm cbx.Checke d, True), tcCurrentD EA])); | |
| 538 | ||
| 539 | Outp utDebugStr ing(Pchar( Format('`% s^`%s^%s^% s^%s^%s', | |
| 540 | [f CurrentPre scriber.IE N, RPCBrok er.User.DU Z, fmcbx.F MField, | |
| 541 | Bo olToStr(aO riginalVal ue, True), BoolToStr (fmcbx.Che cked, True ), | |
| 542 | tc CurrentDEA ]) + chr(1 3) + chr(1 0))); | |
| 543 | end; | |
| 544 | end; | |
| 545 | ||
| 546 | begin | |
| 547 | ||
| 548 | lcCurren tDEA := ge tCurrentIn formation( cboDeaNumb er.ItemInd ex, DEA); | |
| 549 | if (lcCu rrentDEA = '') then | |
| 550 | begin | |
| 551 | ShowMs g(ADD_DEA + ' is cur rently sel ected.', ' Error', sm iError, sm bOK); | |
| 552 | Exit; | |
| 553 | end; | |
| 554 | ||
| 555 | // Build list of b efore and after for changed va lues | |
| 556 | try | |
| 557 | aChang eList := T StringList .Create; | |
| 558 | AddTex tChange(fm edtAltName , fCurrent Prescriber .SubjectAl ternateNam e, | |
| 559 | lcCu rrentDEA); | |
| 560 | ||
| 561 | AddTex tChange(fm edtDeaNumb er, fCurre ntPrescrib er.DEA, lc CurrentDEA ); | |
| 562 | ||
| 563 | AddTex tChange(fm edtVANumbe r, fCurren tPrescribe r.VANumber , lcCurren tDEA); | |
| 564 | AddTex tChange(fm edtDetoxMa intNumber, fCurrentP rescriber. DetoxNumbe r, | |
| 565 | lcCu rrentDEA); | |
| 566 | AddTex tChange(fm edtDeaExpi rationDate , fCurrent Prescriber .DEAExpira tionDate, | |
| 567 | lcCu rrentDEA); | |
| 568 | ||
| 569 | AddBoo leanChange (fmcbxAuth orizedToWr iteOrders, | |
| 570 | fCur rentPrescr iber.Autho rizedToWri te, lcCurr entDEA); | |
| 571 | AddBoo leanChange (fmcbxSche duleV, fCu rrentPresc riber.Allo wScheduleV Narc, | |
| 572 | lcCu rrentDEA); | |
| 573 | AddBoo leanChange (fmcbxSche duleIV, fC urrentPres criber.All owSchedule IVNarc, | |
| 574 | lcCu rrentDEA); | |
| 575 | AddBoo leanChange (fmcbxSche duleIINonN arcotic, | |
| 576 | fCur rentPrescr iber.Allow ScheduleII NonNarc, l cCurrentDE A); | |
| 577 | AddBoo leanChange (fmcbxSche duleIINarc otic, | |
| 578 | fCur rentPrescr iber.Allow ScheduleII Narc, lcCu rrentDEA); | |
| 579 | AddBoo leanChange (fmcbxSche duleIIINon Narcotic, | |
| 580 | fCur rentPrescr iber.Allow ScheduleII INonNarc, lcCurrentD EA); | |
| 581 | AddBoo leanChange (fmcbxSche duleIIINar cotic, | |
| 582 | fCur rentPrescr iber.Allow ScheduleII INarc, lcC urrentDEA) ; | |
| 583 | ||
| 584 | AddBoo leanChange (fmcbxUseI npatient, fCurrentPr escriber.U seForInpat ient, | |
| 585 | lcCu rrentDEA); | |
| 586 | ||
| 587 | if aCh angeList.C ount > 0 t hen | |
| 588 | try | |
| 589 | fm Filer.Upda te; | |
| 590 | fm Filer8991. Update; | |
| 591 | ||
| 592 | wi th RPCBrok er do | |
| 593 | be gin | |
| 594 | RemoteProc edure := ' PSO DEA ED IT'; | |
| 595 | Param[0].P Type := li st; | |
| 596 | for i := 0 to aChang eList.Coun t - 1 do | |
| 597 | Param[0] .Mult[IntT oStr(i)] : = aChangeL ist[i]; | |
| 598 | Call; | |
| 599 | en d; | |
| 600 | ||
| 601 | // Get a fre sh copy of the data from the c omponents | |
| 602 | In itializeDa ta(fCurren tPrescribe r, fmlkupP rescriber. RecordNumb er); | |
| 603 | Sh owMsg('Upd ate Comple ted', 'Inf ormation', smiInfo, smbOK); | |
| 604 | exce pt | |
| 605 | on E: Except ion do | |
| 606 | ShowMsg('E rror updat ing record : ' + E.Me ssage, 'Er ror', | |
| 607 | smiError , smbOK); | |
| 608 | end | |
| 609 | else | |
| 610 | Show Msg('No up dates foun d', 'Infor mation', s miInfo, sm bOK); | |
| 611 | finally | |
| 612 | FreeAn dNil(aChan geList); | |
| 613 | end; | |
| 614 | ||
| 615 | // Refre sh the lis t. | |
| 616 | UpdateDE AList(fmlk upPrescrib er.RecordN umber); | |
| 617 | UpdateDE AComboBox( fmlkupPres criber.Rec ordNumber) ; | |
| 618 | ||
| 619 | end; | |
| 620 | ||
| 621 | procedure TfrmMain.A pplication Exception( Sender: TO bject; E: Exception) ; | |
| 622 | begin | |
| 623 | ShowMsg( E.Message, 'Error', smiError, smbOK); | |
| 624 | Close; | |
| 625 | end; | |
| 626 | ||
| 627 | procedure TfrmMain.b tnAddClick (Sender: T Object); | |
| 628 | var | |
| 629 | lcAddStr ing: Strin g; | |
| 630 | lcResult : String; | |
| 631 | llOkay: Boolean; | |
| 632 | lcMessag e: String; | |
| 633 | begin | |
| 634 | if (Not CheckDEADu plicates) then | |
| 635 | Exit; | |
| 636 | ||
| 637 | lcAddStr ing := Bui ldAddStrin g(); | |
| 638 | ||
| 639 | with RPC Broker do | |
| 640 | try | |
| 641 | Remo teProcedur e := 'PSO DEA ADD DE A'; | |
| 642 | ||
| 643 | Para m[0].Value := lcAddS tring; | |
| 644 | Para m[0].PType := Litera l; | |
| 645 | Para m[1].Value := Piece( fCurrentPr escriber.I ENS, ',', 1); | |
| 646 | Para m[1].PType := Litera l; | |
| 647 | ||
| 648 | Call ; | |
| 649 | lcRe sult := Re sults[0]; | |
| 650 | ||
| 651 | llOk ay := (Pie ce(lcResul t, '^', 1) <> '0'); | |
| 652 | if ( llOkay) th en | |
| 653 | begi n | |
| 654 | ll Okay := (P iece(lcRes ult, '^', 3) <> '0') ; | |
| 655 | if (Not llOk ay) then | |
| 656 | be gin | |
| 657 | lcMessage := Piece(l cResult, ' ^', 4); | |
| 658 | en d; | |
| 659 | end | |
| 660 | else | |
| 661 | begi n | |
| 662 | lc Message := Piece(lcR esult, '^' , 2); | |
| 663 | end; | |
| 664 | ||
| 665 | if ( llOkay) th en | |
| 666 | begi n | |
| 667 | Sh owMsg('DEA # added a nd now sel ectable fr om the Pre scriber DE A # dropdo wn list.', | |
| 668 | smiInfo, s mbOK); | |
| 669 | end | |
| 670 | else | |
| 671 | begi n | |
| 672 | Sh owMsg('Una ble to add this DEA #: ' + lcM essage, sm iError, sm bOK); | |
| 673 | end; | |
| 674 | ||
| 675 | except | |
| 676 | on l oErr: Exce ption do | |
| 677 | begi n | |
| 678 | Sh owMsg('Err or in with the RPC o f PSO DEA ADD DEA: ' + loErr.M essage, | |
| 679 | smiError, smbOK); | |
| 680 | end; | |
| 681 | ||
| 682 | end; | |
| 683 | ||
| 684 | // Refre sh the lis t. | |
| 685 | UpdateDE AList(fmlk upPrescrib er.RecordN umber); | |
| 686 | UpdateDE AComboBox( fmlkupPres criber.Rec ordNumber) ; | |
| 687 | ||
| 688 | end; | |
| 689 | ||
| 690 | function T frmMain.Bu ildAddStri ng(): Stri ng; | |
| 691 | var | |
| 692 | lcResult : string; | |
| 693 | lcDEA: S tring; | |
| 694 | lcSuffix : String; | |
| 695 | begin | |
| 696 | ||
| 697 | lcResult := ''; | |
| 698 | Result : = lcResult ; | |
| 699 | if (fcCo pyDOJInfor mation = ' ') then | |
| 700 | Exit; | |
| 701 | ||
| 702 | lcResult := lcResu lt + Decip horDOJ(fcC opyDOJInfo rmation, | |
| 703 | DOJ_PR OVIDER_NAM E) + '^'; | |
| 704 | ||
| 705 | lcResult := lcResu lt + Decip horDOJ(fcC opyDOJInfo rmation, D OJ_ADDRESS 1) + '^'; | |
| 706 | lcResult := lcResu lt + Decip horDOJ(fcC opyDOJInfo rmation, D OJ_ADDRESS 2) + '^'; | |
| 707 | lcResult := lcResu lt + Decip horDOJ(fcC opyDOJInfo rmation, D OJ_ADDRESS 3) + '^'; | |
| 708 | ||
| 709 | lcResult := lcResu lt + Decip horDOJ(fcC opyDOJInfo rmation, D OJ_CITY) + '^'; | |
| 710 | lcResult := lcResu lt + Decip horDOJ(fcC opyDOJInfo rmation, D OJ_STATE) + '^'; | |
| 711 | lcResult := lcResu lt + Decip horDOJ(fcC opyDOJInfo rmation, | |
| 712 | DOJ_ST ATE_POINTE R) + '^'; | |
| 713 | lcResult := lcResu lt + Decip horDOJ(fcC opyDOJInfo rmation, D OJ_ZIP_COD E) + '^'; | |
| 714 | ||
| 715 | lcResult := lcResu lt + Decip horDOJ(fcC opyDOJInfo rmation, | |
| 716 | DOJ_AC TIVITY_COD E) + '^'; | |
| 717 | lcResult := lcResu lt + Decip horDOJ(fcC opyDOJInfo rmation, D OJ_TYPE) + '^'; | |
| 718 | ||
| 719 | lcDEA := Trim(fmed tDeaNumber .Text); | |
| 720 | // Do no t append t he suffix to the DEA variable. | |
| 721 | lcSuffix := Trim(e dtDEASuffi x.Text); | |
| 722 | ||
| 723 | lcResult := lcResu lt + lcDEA + '^'; | |
| 724 | ||
| 725 | lcResult := lcResu lt + Trim( fmedtDeaEx pirationDa te.Text) + '^'; | |
| 726 | ||
| 727 | lcResult := lcResu lt + Decip horDOJ(fcC opyDOJInfo rmation, | |
| 728 | DOJ_PR OCESSED_DA TE) + '^'; | |
| 729 | ||
| 730 | lcResult := lcResu lt + Trim( fmedtDetox MaintNumbe r.Text) + '^'; | |
| 731 | ||
| 732 | lcResult := lcResu lt + Decip horCheckBo x(fmcbxSch eduleIINar cotic) + ' ^'; | |
| 733 | lcResult := lcResu lt + Decip horCheckBo x(fmcbxSch eduleIINon Narcotic) + '^'; | |
| 734 | lcResult := lcResu lt + Decip horCheckBo x(fmcbxSch eduleIIINa rcotic) + '^'; | |
| 735 | lcResult := lcResu lt + Decip horCheckBo x(fmcbxSch eduleIIINo nNarcotic) + '^'; | |
| 736 | lcResult := lcResu lt + Decip horCheckBo x(fmcbxSch eduleIV) + '^'; | |
| 737 | lcResult := lcResu lt + Decip horCheckBo x(fmcbxSch eduleV) + '^'; | |
| 738 | ||
| 739 | lcResult := lcResu lt + Decip horCheckBo x(fmcbxUse Inpatient) + '^'; | |
| 740 | ||
| 741 | lcResult := lcResu lt + Trim( edtDEASuff ix.Text); | |
| 742 | ||
| 743 | Result : = lcResult ; | |
| 744 | ||
| 745 | end; | |
| 746 | ||
| 747 | function T frmMain.De ciphorChec kBox(toChe ckBox: TCh eckBox): S tring; | |
| 748 | begin | |
| 749 | if (toCh eckBox.Che cked) then | |
| 750 | Result := 'YES' | |
| 751 | else | |
| 752 | Result := 'NO'; | |
| 753 | end; | |
| 754 | ||
| 755 | function T frmMain.Ch eckDEADupl icates(): Boolean; | |
| 756 | var | |
| 757 | lcDEA, l cSuffix, l cResult, l cFirst: St ring; | |
| 758 | lnLen: I nteger; | |
| 759 | ||
| 760 | begin | |
| 761 | Result : = True; | |
| 762 | ||
| 763 | lcDEA := Trim(fmed tDeaNumber .Text); | |
| 764 | lcSuffix := Trim(e dtDEASuffi x.Text); | |
| 765 | ||
| 766 | if (edtD EASuffix.E nabled) th en | |
| 767 | begin | |
| 768 | lnLen := Length( lcSuffix); | |
| 769 | if ((l nLen < DEA _SUFFIX_MI N) OR (lnL en > DEA_S UFFIX_MAX) ) then | |
| 770 | begin | |
| 771 | Show Msg('As th is is an i nstitution al DEA num ber, you m ust enter a unique ' | |
| 772 | + lblDEASuff ix.Caption + ' betwe en ' + Int ToStr(DEA_ SUFFIX_MIN ) + | |
| 773 | ' and ' + In tToStr(DEA _SUFFIX_MA X) + ' cha racters in length.', | |
| 774 | sm iError, sm bOK); | |
| 775 | ||
| 776 | Resu lt := Fals e; | |
| 777 | Exit ; | |
| 778 | end; | |
| 779 | end; | |
| 780 | ||
| 781 | with RPC Broker do | |
| 782 | try | |
| 783 | Remo teProcedur e := 'PSO DEA DUP CH ECK'; | |
| 784 | ||
| 785 | Para m[0].Value := lcDEA; | |
| 786 | Para m[0].PType := Litera l; | |
| 787 | Para m[1].Value := lcSuff ix; | |
| 788 | Para m[1].PType := Litera l; | |
| 789 | ||
| 790 | Call ; | |
| 791 | lcRe sult := Re sults[0]; | |
| 792 | lcFi rst := Pie ce(lcResul t, '^', 1) ; | |
| 793 | ||
| 794 | Resu lt := (lcF irst <> '0 '); | |
| 795 | if ( Not Result ) then | |
| 796 | begi n | |
| 797 | Sh owMsg(Piec e(lcResult , '^', 2), smiError, smbOK); | |
| 798 | end; | |
| 799 | ||
| 800 | except | |
| 801 | on l oErr: Exce ption do | |
| 802 | begi n | |
| 803 | Sh owMsg('Err or in Chec kDEADuplic ates: ' + loErr.Mess age, | |
| 804 | smiError, smbOK); | |
| 805 | Re sult := Fa lse; | |
| 806 | end; | |
| 807 | ||
| 808 | end; | |
| 809 | ||
| 810 | end; | |
| 811 | ||
| 812 | procedure TfrmMain.b tnCopyClic k(Sender: TObject); | |
| 813 | var | |
| 814 | lcDEA: S tring; | |
| 815 | lcCaptio n: String; | |
| 816 | lcProvid er: String ; | |
| 817 | lcDOJPro vider: Str ing; | |
| 818 | ||
| 819 | lcProvid erLastName : String; | |
| 820 | lcDOJPro viderLastN ame: Strin g; | |
| 821 | lcError: String; | |
| 822 | ||
| 823 | lcInstit ution: Str ing; | |
| 824 | llInstit ution: Boo lean; | |
| 825 | lcMessag e: String; | |
| 826 | llExit: Boolean; | |
| 827 | begin | |
| 828 | ||
| 829 | lcDEA := Trim(fmed tDeaNumber .Text); | |
| 830 | if Not C heckDEAFor mat(lcDEA) then | |
| 831 | Exit; | |
| 832 | ||
| 833 | UpdateDO JControls( False, lcD EA, fcCopy DOJInforma tion, lcEr ror); | |
| 834 | lcProvid er := Trim (fmedtProv iderName.T ext); | |
| 835 | lcDOJPro vider := D eciphorDOJ (fcCopyDOJ Informatio n, DOJ_PRO VIDER_NAME ); | |
| 836 | lcInstit ution := U pperCase(T rim(Deciph orDOJ(fcCo pyDOJInfor mation, DO J_TYPE))); | |
| 837 | llInstit ution := ( lcInstitut ion = DOJ_ INSTITUTIO N); | |
| 838 | ||
| 839 | lcProvid erLastName := GetLas tName(lcPr ovider); | |
| 840 | lcDOJPro viderLastN ame := Get LastName(l cDOJProvid er); | |
| 841 | ||
| 842 | llExit : = False; | |
| 843 | ||
| 844 | if (lcDO JProvider = DOJ_EMPT Y) then | |
| 845 | begin | |
| 846 | ShowMs g(lcDEA + ' is inval id. Please check the number en tered:' + CRLF + | |
| 847 | CRLF + lcError , smiError , smbOK); | |
| 848 | llExit := True; | |
| 849 | end | |
| 850 | else if (llInstitu tion) then | |
| 851 | begin | |
| 852 | lcMess age := 'DO J Name: ' + lcDOJPro vider + CR LF + 'Vist a Name: ' + | |
| 853 | lcPr ovider + C RLF + CRLF + | |
| 854 | 'The names don ''t match as this is an instit utional DE A #.' + CR LF + CRLF | |
| 855 | + 'D o you real ly want to continue? '; | |
| 856 | ||
| 857 | if (Sh owMsg(lcMe ssage, smi Question, smbYesNo) <> smrYes) then | |
| 858 | llEx it := True ; | |
| 859 | end | |
| 860 | else if (lcDOJProv iderLastNa me <> lcPr oviderLast Name) then | |
| 861 | begin | |
| 862 | lcMess age := lcD EA + ' is associate d with ' + lcDOJProv ider + | |
| 863 | '. L ast Names do not mat ch.' + CRL F + CRLF + 'Do you w ish to con tinue?'; | |
| 864 | ||
| 865 | if (Sh owMsg(lcMe ssage, smi Question, smbYesNo) <> smrYes) then | |
| 866 | llEx it := True ; | |
| 867 | end; | |
| 868 | ||
| 869 | if (llEx it) then | |
| 870 | begin | |
| 871 | btnAdd .Enabled : = False; | |
| 872 | edtDEA Suffix.Ena bled := Fa lse; | |
| 873 | BlankD OJFields; | |
| 874 | ||
| 875 | Exit; | |
| 876 | end; | |
| 877 | ||
| 878 | btnCopy. Enabled := False; | |
| 879 | btnAdd.E nabled := True; | |
| 880 | ||
| 881 | fmcbxUse Inpatient. Enabled := Not llIns titution; | |
| 882 | // If a non-instit utional DE A and the provider h as no DEA # yet. | |
| 883 | fmcbxUse Inpatient. Checked := ((fmcbxUs eInpatient .Enabled) And | |
| 884 | (Count ValidDEANu mbers = 0) ); | |
| 885 | ||
| 886 | setEnabl e(edtDEASu ffix, llIn stitution) ; | |
| 887 | ||
| 888 | lcCaptio n := Trim( lblDetoxMa intNumberD OJ.Caption ); | |
| 889 | if (lcCa ption <> D OJ_EMPTY) then | |
| 890 | fmedtD etoxMaintN umber.Text := lcCapt ion; | |
| 891 | ||
| 892 | lcCaptio n := Trim( lblDeaExpi rationDate DOJ.Captio n); | |
| 893 | if (lcCa ption <> D OJ_EMPTY) then | |
| 894 | fmedtD eaExpirati onDate.Tex t := lcCap tion; | |
| 895 | ||
| 896 | fmcbxSch eduleV.Che cked := ch kScheduleV DOJ.Checke d; | |
| 897 | fmcbxSch eduleIV.Ch ecked := c hkSchedule IVDOJ.Chec ked; | |
| 898 | fmcbxSch eduleIINon Narcotic.C hecked := chkSchedul eIINonNarc oticDOJ.Ch ecked; | |
| 899 | fmcbxSch eduleIINar cotic.Chec ked := chk ScheduleII NarcoticDO J.Checked; | |
| 900 | fmcbxSch eduleIIINo nNarcotic. Checked := chkSchedu leIIINonNa rcoticDOJ. Checked; | |
| 901 | fmcbxSch eduleIIINa rcotic.Che cked := ch kScheduleI IINarcotic DOJ.Checke d; | |
| 902 | end; | |
| 903 | ||
| 904 | function T frmMain.Ch eckDEAForm at(tcDEA: String): B oolean; | |
| 905 | var | |
| 906 | i: Integ er; | |
| 907 | c: Char; | |
| 908 | lcMessag e: String; | |
| 909 | begin | |
| 910 | lcMessag e := | |
| 911 | 'Enter the DEA n umber in t he format of 2 lette rs followe d by 7 num bers.'; | |
| 912 | ||
| 913 | if (Leng th(tcDEA) <> 9) then | |
| 914 | begin | |
| 915 | ShowMs g(lcMessag e, smiErro r, smbOK); | |
| 916 | Result := False; | |
| 917 | Exit; | |
| 918 | end; | |
| 919 | ||
| 920 | for i := 1 to 2 do | |
| 921 | begin | |
| 922 | c := t cDEA[i]; | |
| 923 | if Not (c.IsLette r) then | |
| 924 | begin | |
| 925 | Show Msg(lcMess age, smiEr ror, smbOK ); | |
| 926 | Resu lt := Fals e; | |
| 927 | Exit ; | |
| 928 | end; | |
| 929 | end; | |
| 930 | ||
| 931 | for i := 3 to 9 do | |
| 932 | begin | |
| 933 | c := t cDEA[i]; | |
| 934 | if Not (c.IsDigit ) then | |
| 935 | begin | |
| 936 | Show Msg(lcMess age, smiEr ror, smbOK ); | |
| 937 | Resu lt := Fals e; | |
| 938 | Exit ; | |
| 939 | end; | |
| 940 | end; | |
| 941 | ||
| 942 | Result : = True; | |
| 943 | end; | |
| 944 | ||
| 945 | procedure TfrmMain.B lankDOJFie lds(); | |
| 946 | begin | |
| 947 | lblProvi derNameDOJ .Caption : = ''; | |
| 948 | lblDetox MaintNumbe rDOJ.Capti on := ''; | |
| 949 | lblDeaEx pirationDa teDOJ.Capt ion := ''; | |
| 950 | chkSched uleIINarco ticDOJ.Che cked := Fa lse; | |
| 951 | chkSched uleIINonNa rcoticDOJ. Checked := False; | |
| 952 | chkSched uleIIINarc oticDOJ.Ch ecked := F alse; | |
| 953 | chkSched uleIIINonN arcoticDOJ .Checked : = False; | |
| 954 | chkSched uleIVDOJ.C hecked := False; | |
| 955 | chkSched uleVDOJ.Ch ecked := F alse; | |
| 956 | end; | |
| 957 | ||
| 958 | procedure TfrmMain.b tnEditClic k(Sender: TObject); | |
| 959 | var | |
| 960 | loForm: TfrmFile20 0; | |
| 961 | begin | |
| 962 | loForm : = TfrmFile 200.Create (frmMain, RPCBroker, fCurrentP rescriber, | |
| 963 | fmedtV ANumber); | |
| 964 | loForm.S howModal() ; | |
| 965 | ||
| 966 | FreeAndN il(loForm) ; | |
| 967 | end; | |
| 968 | ||
| 969 | // Assumes that the format is LastName, FirstName | |
| 970 | function T frmMain.Ge tLastName( tcName: St ring): Str ing; | |
| 971 | var | |
| 972 | lnPos: I nteger; | |
| 973 | begin | |
| 974 | Result : = Trim(tcN ame); | |
| 975 | ||
| 976 | lnPos := Pos(',', tcName); | |
| 977 | if (lnPo s > 1) the n | |
| 978 | Result := Trim(C opy(tcName , 1, lnPos - 1)); | |
| 979 | ||
| 980 | end; | |
| 981 | ||
| 982 | procedure TfrmMain.s etEnable(t oEdit: TEd it; tlEnab le: Boolea n); | |
| 983 | begin | |
| 984 | if (tlEn able) then | |
| 985 | begin | |
| 986 | toEdit .Color := clWhite; | |
| 987 | toEdit .ReadOnly := False; | |
| 988 | toEdit .Enabled : = True; | |
| 989 | toEdit .TabStop : = True; | |
| 990 | end | |
| 991 | else | |
| 992 | begin | |
| 993 | toEdit .Color := cl3DLight; | |
| 994 | toEdit .ReadOnly := True; | |
| 995 | toEdit .Enabled : = False; | |
| 996 | toEdit .TabStop : = False; | |
| 997 | end; | |
| 998 | ||
| 999 | end; | |
| 1000 | ||
| 1001 | procedure TfrmMain.b tnRemoveCl ick(Sender : TObject) ; | |
| 1002 | var | |
| 1003 | lcResult , lcFirst: String; | |
| 1004 | lcDEA, l cNPIENS: S tring; | |
| 1005 | llSucces s: Boolean ; | |
| 1006 | lnIndex: Integer; | |
| 1007 | lcDetox, lcDeleteM sg: String ; | |
| 1008 | lcVANumb er: String ; | |
| 1009 | begin | |
| 1010 | ||
| 1011 | lcDetox := Trim(fm edtDetoxMa intNumber. Text); | |
| 1012 | if (lcDe tox <> '') then | |
| 1013 | begin | |
| 1014 | lcDele teMsg := ' This DEA # contains Detox # ' + lcDetox + | |
| 1015 | '. T o maintain the Detox #, please add it to another D EA # on th e provider ’s profile .' | |
| 1016 | + CR LF + CRLF + 'Do you want to co ntinue the deletion process?'; | |
| 1017 | ||
| 1018 | if (Sh owMsg(lcDe leteMsg, ' Confirm', smiQuestio n, smbYesN o) <> smrY es) then | |
| 1019 | Exit ; | |
| 1020 | end; | |
| 1021 | ||
| 1022 | lcVANumb er := Trim (fmedtVANu mber.Text) ; | |
| 1023 | // There is always 1 with th e Add DEA option. So 2 means o nly one DE A #. | |
| 1024 | if ((lcV ANumber = '') And (c boDeaNumbe r.Items.Co unt = 2)) then | |
| 1025 | begin | |
| 1026 | lcDele teMsg := | |
| 1027 | 'Thi s is the o nly DEA nu mber on fi le for thi s provider . The prov ider will no longer be able to prescribe controlle d substanc es at the VA.' | |
| 1028 | + CR LF + CRLF + 'Do you want to co ntinue the deletion process?'; | |
| 1029 | ||
| 1030 | if (Sh owMsg(lcDe leteMsg, ' Confirm', smiQuestio n, smbYesN o) <> smrY es) then | |
| 1031 | Exit ; | |
| 1032 | end; | |
| 1033 | ||
| 1034 | lcDEA := fmedtDeaN umber.Text ; | |
| 1035 | lnIndex := cboDeaN umber.Item Index; | |
| 1036 | // We mu st use the NPIEN - N EW PERSON FILE #200 INTERNAL E NTRY NUMBE R | |
| 1037 | // Also, the numbe r will be in the for mat of #,# #####,##, and | |
| 1038 | // we wa nt the 2nd number. | |
| 1039 | lcNPIENS := Piece( getCurrent Informatio n(lnIndex, NPIENS), ',', 2); | |
| 1040 | ||
| 1041 | if (Show Msg('Do yo u wish to remove the current D EA # of ' + lcDEA + '?' + CRLF | |
| 1042 | + CRLF + 'Removi ng the DEA number do es not aff ect previo usly writt en prescri ptions.', | |
| 1043 | 'Confi rm', smiQu estion, sm bYesNo) = smrYes) th en | |
| 1044 | begin | |
| 1045 | with R PCBroker d o | |
| 1046 | try | |
| 1047 | Re moteProced ure := 'PS O DEA REMO VE DEA'; | |
| 1048 | ||
| 1049 | Pa ram[0].Val ue := lcNP IENS; | |
| 1050 | Pa ram[0].PTy pe := Lite ral; | |
| 1051 | Pa ram[1].Val ue := lcDE A; | |
| 1052 | Pa ram[1].PTy pe := Lite ral; | |
| 1053 | ||
| 1054 | Ca ll; | |
| 1055 | lc Result := Results[0] ; | |
| 1056 | lc First := P iece(lcRes ult, '^', 1); | |
| 1057 | ll Success := (lcFirst = '1'); | |
| 1058 | ||
| 1059 | if (llSucces s) then | |
| 1060 | be gin | |
| 1061 | ShowMsg(lc DEA + ' wa s deleted. ', 'Succes s', smiInf o, smbOK); | |
| 1062 | // Refresh the list. | |
| 1063 | UpdateDEAL ist(fmlkup Prescriber .RecordNum ber); | |
| 1064 | UpdateDEAC omboBox(fm lkupPrescr iber.Recor dNumber); | |
| 1065 | en d | |
| 1066 | el se | |
| 1067 | be gin | |
| 1068 | ShowMsg('U nable to d elete ' + lcDEA + ' (NPIENS: ' + lcNPIEN S + ').', | |
| 1069 | 'Error', smiError, smbOK); | |
| 1070 | en d; | |
| 1071 | ||
| 1072 | exce pt | |
| 1073 | on loErr: Ex ception do | |
| 1074 | be gin | |
| 1075 | ShowMsg('T here was a n error in deleting: ' + loErr .Message, 'Error', | |
| 1076 | smiError , smbOK); | |
| 1077 | en d; | |
| 1078 | ||
| 1079 | end; | |
| 1080 | ||
| 1081 | end; | |
| 1082 | end; | |
| 1083 | ||
| 1084 | function T frmMain.Ho ldsVistAKe y(AKeyName : string): Boolean; | |
| 1085 | begin | |
| 1086 | with RPC Broker do | |
| 1087 | try | |
| 1088 | Remo teProcedur e := 'XUS KEY CHECK' ; | |
| 1089 | Para m[0].Value := AKeyNa me; | |
| 1090 | Para m[0].PType := Litera l; | |
| 1091 | Call ; | |
| 1092 | Resu lt := (Ans iCompareTe xt(Results [0], '1') = 0); | |
| 1093 | except | |
| 1094 | Resu lt := Fals e; | |
| 1095 | end; | |
| 1096 | end; | |
| 1097 | ||
| 1098 | function T frmMain.Ed itVANumber : Boolean; | |
| 1099 | var | |
| 1100 | lcValue: string; | |
| 1101 | begin | |
| 1102 | ||
| 1103 | lcValue := ',' + T rim(fmlblP roviderTyp e.Caption) + ','; | |
| 1104 | ||
| 1105 | Result : = (PROVIDE R_TYPES_VA .Contains( lcValue)); | |
| 1106 | end; | |
| 1107 | ||
| 1108 | function T frmMain.Di splayWarni ng: Boolea n; | |
| 1109 | var | |
| 1110 | lcResult : string; | |
| 1111 | lcFirst: string; | |
| 1112 | begin | |
| 1113 | with RPC Broker do | |
| 1114 | try | |
| 1115 | Remo teProcedur e := 'PSO DEA MBM'; | |
| 1116 | Call ; | |
| 1117 | lcRe sult := Re sults[0]; | |
| 1118 | lcFi rst := Pie ce(lcResul t, '^', 1) ; | |
| 1119 | ||
| 1120 | Resu lt := (lcF irst <> '1 '); | |
| 1121 | except | |
| 1122 | on E : Exceptio n do | |
| 1123 | begi n | |
| 1124 | Re sult := Tr ue; | |
| 1125 | end; | |
| 1126 | ||
| 1127 | end; | |
| 1128 | ||
| 1129 | end; | |
| 1130 | ||
| 1131 | function T frmMain.Is ActiveUser : Boolean; | |
| 1132 | var | |
| 1133 | aTermina tionDate: TDateTime; | |
| 1134 | begin | |
| 1135 | Result : = False; | |
| 1136 | with TSt ringList.C reate do | |
| 1137 | try | |
| 1138 | if f medtAccess Code.Text = '' then | |
| 1139 | Ad d(' - has NO ACCESS CODE'); | |
| 1140 | ||
| 1141 | if f medtVerify Code.Text = '' then | |
| 1142 | Ad d(' - has NO VERIFY CODE'); | |
| 1143 | ||
| 1144 | if f medtDISUSE Red.Text = 'YES' the n | |
| 1145 | Ad d(' - is DISUSERed' ); | |
| 1146 | ||
| 1147 | if f medtTermin ationDate. FMCtrlInte rnal <> '' then | |
| 1148 | begi n | |
| 1149 | aT ermination Date := FM DateTime2T DateTime | |
| 1150 | (fmedtTerm inationDat e.FMCtrlIn ternal); | |
| 1151 | if (Now >= a Terminatio nDate) the n | |
| 1152 | Add(Format (' - was terminated as of %s' , | |
| 1153 | [FormatD ateTime('M MM D, YYYY ', aTermin ationDate) ])); | |
| 1154 | end; | |
| 1155 | ||
| 1156 | if ( (Count > 0 ) And (Dis playWarnin g)) then | |
| 1157 | begi n | |
| 1158 | In sert(0, 'T his is NOT an active prescribe r.'); | |
| 1159 | In sert(1, '' ); | |
| 1160 | In sert(2, 'T his prescr iber:'); | |
| 1161 | Ad d(''); | |
| 1162 | Ad d('Press Y es to cont inue proce ssing with inactive prescriber . Press No to select a differe nt prescri ber.'); | |
| 1163 | Re sult := Sh owMsg(Text , 'Confirm ', smiQues tion, smbY esNo) = sm rYes; | |
| 1164 | end | |
| 1165 | else | |
| 1166 | Re sult := Tr ue; | |
| 1167 | Free ; | |
| 1168 | except | |
| 1169 | on E : Exceptio n do | |
| 1170 | begi n | |
| 1171 | Sh owMsg(E.Me ssage, 'Er ror', smiE rror, smbO K); | |
| 1172 | Fr ee; | |
| 1173 | end; | |
| 1174 | end; | |
| 1175 | end; | |
| 1176 | ||
| 1177 | function T frmMain.FM DateTime2T DateTime(a Value: str ing): TDat eTime; | |
| 1178 | var | |
| 1179 | y, m, d: Word; | |
| 1180 | begin | |
| 1181 | y := (17 00 + StrTo Int(Copy(a Value, 1, 3))); | |
| 1182 | m := Str ToInt(Copy (aValue, 4 , 2)); | |
| 1183 | d := Str ToInt(Copy (aValue, 6 , 2)); | |
| 1184 | Result : = EncodeDa te(y, m, d ) + Encode Time(0, 0, 0, 0); | |
| 1185 | end; | |
| 1186 | ||
| 1187 | procedure TfrmMain.f medtAltNam eExit(Send er: TObjec t); | |
| 1188 | var | |
| 1189 | Bad: Boo lean; | |
| 1190 | Name: st ring; | |
| 1191 | PartStr: string; | |
| 1192 | Mesg: st ring; | |
| 1193 | AtPos: I nteger; | |
| 1194 | begin | |
| 1195 | Bad := F alse; | |
| 1196 | ||
| 1197 | name := fmedtAltNa me.Text; | |
| 1198 | AtPos := Pos('@', name); | |
| 1199 | if not(A tPos > 0) then | |
| 1200 | begin | |
| 1201 | Bad := True; | |
| 1202 | end | |
| 1203 | else if not(Pos('. ', fmedtAl tName.Text ) < AtPos) then | |
| 1204 | begin | |
| 1205 | Bad := True; | |
| 1206 | end | |
| 1207 | else | |
| 1208 | begin | |
| 1209 | PartSt r := Copy( fmedtAltNa me.Text, A tPos + 1, Length(fme dtAltName. Text)); | |
| 1210 | if not (Pos('.', PartStr) > 1) then | |
| 1211 | begin | |
| 1212 | Bad := True; | |
| 1213 | end; | |
| 1214 | end; | |
| 1215 | if Bad t hen | |
| 1216 | begin | |
| 1217 | Mesg : = 'This is the user' 's primary work e-ma il address ' + #10#13 ; | |
| 1218 | Mesg : = Mesg + ' It must be in the fo rmat' + #1 0#13#10#13 ; | |
| 1219 | Mesg : = Mesg + ' first.last @agency.ty pe,' + #10 #13#10#13; | |
| 1220 | Mesg := Me sg + '(e.g ., john.pu blic@ DOMAIN )' + #10#1 3#10#13#10 #13; | |
| 1221 | Mesg : = Mesg + ' where firs t.last are first and last name s' + #10#1 3; | |
| 1222 | Mesg : = Mesg + ' (and the l ast name m ay followe d by a num eric digit ).'; | |
| 1223 | ShowMs g(Mesg, 'I nformation ', smiInfo , smbOK); | |
| 1224 | fmedtA ltName.Tex t := fCurr entPrescri ber.Subjec tAlternate Name; | |
| 1225 | end; | |
| 1226 | ||
| 1227 | end; | |
| 1228 | ||
| 1229 | procedure TfrmMain.U pperCaseCh ange(Sende r: TObject ); | |
| 1230 | var | |
| 1231 | loEdit: TEdit; | |
| 1232 | lnSelect : Integer; | |
| 1233 | loEvent: TNotifyEv ent; | |
| 1234 | begin | |
| 1235 | ||
| 1236 | loEdit : = Sender A s TEdit; | |
| 1237 | ||
| 1238 | loEvent := loEdit. OnChange; | |
| 1239 | loEdit.O nChange := nil; | |
| 1240 | ||
| 1241 | lnSelect := loEdit .SelStart; | |
| 1242 | loEdit.T ext := Upp erCase(loE dit.Text); | |
| 1243 | ||
| 1244 | if (lnSe lect > Len gth(loEdit .Text)) th en | |
| 1245 | loEdit .SelStart := Length( loEdit.Tex t) | |
| 1246 | else | |
| 1247 | loEdit .SelStart := lnSelec t; | |
| 1248 | ||
| 1249 | loEdit.O nChange := loEvent; | |
| 1250 | ||
| 1251 | end; | |
| 1252 | ||
| 1253 | procedure TfrmMain.C heckDetoxN umber(Send er: TObjec t; var Key : Word; | |
| 1254 | Shift: T ShiftState ); | |
| 1255 | var | |
| 1256 | loEdit: TEdit; | |
| 1257 | loEvent: TNotifyEv ent; | |
| 1258 | i, lnCou nt, lnTrac k: Integer ; | |
| 1259 | lcLine, lcDetox: S tring; | |
| 1260 | lcCurren tDEA, lcDe toxDEA: St ring; | |
| 1261 | begin | |
| 1262 | ||
| 1263 | loEdit : = Sender A s TEdit; | |
| 1264 | if (Not loEdit.Ena bled) then | |
| 1265 | Exit; | |
| 1266 | ||
| 1267 | loEvent := loEdit. OnChange; | |
| 1268 | loEdit.O nChange := nil; | |
| 1269 | ||
| 1270 | lcDetoxD EA := ''; | |
| 1271 | lcCurren tDEA := Tr im(fmedtDe aNumber.Te xt); | |
| 1272 | ||
| 1273 | lnCount := foPresc riberDEALi st.Count; | |
| 1274 | lnTrack := 0; | |
| 1275 | for i := 0 to lnCo unt - 1 do | |
| 1276 | begin | |
| 1277 | lcLine := foPres criberDEAL ist[i]; | |
| 1278 | if (lc Line <> AD D_DEA) the n | |
| 1279 | begin | |
| 1280 | lcDe tox := get CurrentInf ormation(i , DETOX); | |
| 1281 | ||
| 1282 | if ( Length(lcD etox) > 0) then | |
| 1283 | begi n | |
| 1284 | ln Track := l nTrack + 1 ; | |
| 1285 | if (lcDetoxD EA = '') t hen | |
| 1286 | lcDetoxDEA := getCur rentInform ation(i, D EA); | |
| 1287 | end; | |
| 1288 | end; | |
| 1289 | end; | |
| 1290 | ||
| 1291 | if ((lnT rack > 0) And (lcDet oxDEA <> l cCurrentDE A)) then | |
| 1292 | begin | |
| 1293 | loEdit .Text := ' '; | |
| 1294 | ShowMs g('Detox # has alrea dy been se t for anot her DEA # with this provider.' , | |
| 1295 | smiE rror, smbO K); | |
| 1296 | end; | |
| 1297 | ||
| 1298 | loEdit.O nChange := loEvent; | |
| 1299 | ||
| 1300 | end; | |
| 1301 | ||
| 1302 | procedure TfrmMain.I nitializeD ata(aPCSPr escriber: TPCSPrescr iber; | |
| 1303 | tcDUZ: s tring); | |
| 1304 | var | |
| 1305 | i: Integ er; | |
| 1306 | CurrObje ct: TObjec t; | |
| 1307 | ||
| 1308 | begin | |
| 1309 | edtFacil ityDEANum. Text := Ge tFacilityV ANum(aPCSP rescriber. IENS); | |
| 1310 | fmGetsPr escriber.I ENS := aPC SPrescribe r.IENS; | |
| 1311 | fmGetsPr escriber.G etandFill; | |
| 1312 | ||
| 1313 | // Why i s this nee ded? The c heckbox ca n't proces s a boolea n??? | |
| 1314 | for i := 0 to pnlM ain.Contro lCount - 1 do | |
| 1315 | begin | |
| 1316 | CurrOb ject := pn lMain.Cont rols[i]; | |
| 1317 | if Cur rObject is TFMCheckB ox then | |
| 1318 | TFMC heckBox(Cu rrObject). Checked := | |
| 1319 | (T FMCheckBox (CurrObjec t).FMCtrlI nternal = '1'); | |
| 1320 | end; | |
| 1321 | ||
| 1322 | UpdateDE AList(tcDU Z); | |
| 1323 | UpdateDE AComboBox( tcDUZ); | |
| 1324 | ||
| 1325 | end; | |
| 1326 | ||
| 1327 | procedure TfrmMain.U pdateDEACo mboBox(tcD UZ: String ); | |
| 1328 | var | |
| 1329 | i: Integ er; | |
| 1330 | lnCount: Integer; | |
| 1331 | lcDEA, l cState, lc Line: stri ng; | |
| 1332 | ||
| 1333 | begin | |
| 1334 | cboDeaNu mber.Items .Clear; | |
| 1335 | lnCount := foPresc riberDEALi st.Count; | |
| 1336 | ||
| 1337 | if (lnCo unt = 0) t hen | |
| 1338 | begin | |
| 1339 | cboDea Number.Ite ms.Add('Er ror readin g the DUZ # of ' + t cDUZ + '.' ); | |
| 1340 | end | |
| 1341 | else | |
| 1342 | begin | |
| 1343 | for i := 0 to ln Count - 1 do | |
| 1344 | begin | |
| 1345 | lcLi ne := foPr escriberDE AList[i]; | |
| 1346 | if ( lcLine = A DD_DEA) th en | |
| 1347 | begi n | |
| 1348 | cb oDeaNumber .Items.Add (lcLine); | |
| 1349 | end | |
| 1350 | else | |
| 1351 | begi n | |
| 1352 | lc DEA := get CurrentInf ormation(i , DEA); | |
| 1353 | lc State := g etCurrentI nformation (i, STATE) ; | |
| 1354 | ||
| 1355 | cb oDeaNumber .Items.Add (lcDEA + ' ' + lcSta te); | |
| 1356 | end; | |
| 1357 | ||
| 1358 | end; | |
| 1359 | end; | |
| 1360 | ||
| 1361 | // Selec t the firs t item. | |
| 1362 | cboDeaNu mber.ItemI ndex := 0; | |
| 1363 | cboDeaNu mberChange (nil); | |
| 1364 | ||
| 1365 | end; | |
| 1366 | ||
| 1367 | procedure TfrmMain.U pdateDEALi st(tcDUZ: String); | |
| 1368 | var | |
| 1369 | loDEALis t: TString s; | |
| 1370 | ||
| 1371 | begin | |
| 1372 | with RPC Broker do | |
| 1373 | try | |
| 1374 | Remo teProcedur e := 'PSO DEA DEALIS T'; | |
| 1375 | Para m[0].Value := tcDUZ; | |
| 1376 | Para m[0].PType := Litera l; | |
| 1377 | Call ; | |
| 1378 | loDE AList := R esults; | |
| 1379 | except | |
| 1380 | loDE AList := T StringList .Create; | |
| 1381 | loDE AList.Clea r; | |
| 1382 | end; | |
| 1383 | ||
| 1384 | // For s ome odd re ason, TStr ings does not mainta in the dat a, and it | |
| 1385 | // gets reset. So I'm using TStringLis t to store the data. | |
| 1386 | foPrescr iberDEALis t := TStri ngList.Cre ate; | |
| 1387 | if (loDE AList.Coun t > 0) the n | |
| 1388 | begin | |
| 1389 | if (No t Contains Text(Lower Case(loDEA List[0]), 'invalid') ) then | |
| 1390 | begin | |
| 1391 | foPr escriberDE AList.Assi gn(loDEALi st); | |
| 1392 | end; | |
| 1393 | end; | |
| 1394 | ||
| 1395 | foPrescr iberDEALis t.Add(ADD_ DEA); | |
| 1396 | ||
| 1397 | end; | |
| 1398 | ||
| 1399 | procedure TfrmMain.c boDeaNumbe rChange(Se nder: TObj ect); | |
| 1400 | var | |
| 1401 | lnIndex: Integer; | |
| 1402 | llAddReq uest: Bool ean; | |
| 1403 | lcInstit ution: Str ing; | |
| 1404 | llInstit ution: Boo lean; | |
| 1405 | lcDOJ, l cError: St ring; | |
| 1406 | begin | |
| 1407 | flValida teOnClickU seInpatien tOrder := False; | |
| 1408 | ||
| 1409 | lnIndex := cboDeaN umber.Item Index; | |
| 1410 | llAddReq uest := (f oPrescribe rDEAList[l nIndex] = ADD_DEA); | |
| 1411 | ||
| 1412 | if (Not llAddReque st) then | |
| 1413 | begin | |
| 1414 | fmVali dator8991. IENS := ge tCurrentIn formation( lnIndex, D NIENS); | |
| 1415 | ||
| 1416 | fmGets Prescriber 8991.IENS := getCurr entInforma tion(lnInd ex, DNIENS ); | |
| 1417 | fmGets Prescriber 8991.Getan dFill; | |
| 1418 | end | |
| 1419 | else | |
| 1420 | begin | |
| 1421 | // Thi s applies to Provide rs with no initial D EA #s and the copy f eature. | |
| 1422 | // For some reas on, if you don't set the IENS number | |
| 1423 | // of the text f ields (not the check boxes), t he Validat or.IENS co mplains | |
| 1424 | // tha t it has n ot been in itialized. | |
| 1425 | // And you can s et fmValid ator8991.I ENS and fm GetsPrescr iber8991.I ENS to IEN S_ADD and | |
| 1426 | // run GetAndFil l. Same er ror. Or if you have selected a previous DEA #, | |
| 1427 | // the se compone nts rememb er the pre vious IENS . Weird. | |
| 1428 | ||
| 1429 | fmedtD eaNumber.I ENS := IEN S_ADD; | |
| 1430 | fmedtD etoxMaintN umber.IENS := IENS_A DD; | |
| 1431 | fmedtD eaExpirati onDate.IEN S := IENS_ ADD; | |
| 1432 | end; | |
| 1433 | // Other wise, noth ing is loa ded as the IENS numb er is +1 | |
| 1434 | // and e xisting va lues remai n. | |
| 1435 | ||
| 1436 | updateCo ntrolsOnSe lect(llAdd Request, l nIndex); | |
| 1437 | UpdateRC PVariables (); | |
| 1438 | UpdateDO JControls( llAddReque st, getCur rentInform ation(lnIn dex, DEA), | |
| 1439 | lcDOJ, lcError); | |
| 1440 | CheckInp atientWarn ing(); | |
| 1441 | ||
| 1442 | lcInstit ution := U pperCase(T rim(Deciph orDOJ(lcDO J, DOJ_TYP E))); | |
| 1443 | llInstit ution := ( lcInstitut ion = DOJ_ INSTITUTIO N); | |
| 1444 | fmcbxUse Inpatient. Enabled := Not llIns titution; | |
| 1445 | ||
| 1446 | flValida teOnClickU seInpatien tOrder := True; | |
| 1447 | ||
| 1448 | end; | |
| 1449 | ||
| 1450 | procedure TfrmMain.U pdateDOJCo ntrols(tlA ddRequest: Boolean; tcDEA: Str ing; | |
| 1451 | var tcIn fo: String ; var tcEr ror: Strin g); | |
| 1452 | var | |
| 1453 | loDOJInf o: TString s; | |
| 1454 | lcDOJ: S tring; | |
| 1455 | lcSucces s: String; | |
| 1456 | ||
| 1457 | begin | |
| 1458 | tcInfo : = ''; | |
| 1459 | tcError := ''; | |
| 1460 | ||
| 1461 | if ((tlA ddRequest) Or (tcDEA = '')) th en | |
| 1462 | Exit; | |
| 1463 | ||
| 1464 | lcDOJ := ''; | |
| 1465 | ||
| 1466 | with RPC Broker do | |
| 1467 | try | |
| 1468 | Remo teProcedur e := 'PSO DEA DEADOJ '; | |
| 1469 | Para m[0].Value := Piece( tcDEA, '-' , 1); | |
| 1470 | Para m[0].PType := Litera l; | |
| 1471 | Call ; | |
| 1472 | loDO JInfo := R esults; | |
| 1473 | except | |
| 1474 | loDO JInfo := T StringList .Create; | |
| 1475 | loDO JInfo.Clea r; | |
| 1476 | end; | |
| 1477 | ||
| 1478 | if (loDO JInfo.Coun t > 0) the n | |
| 1479 | begin | |
| 1480 | lcSucc ess := Tri m(Piece(lo DOJInfo[0] , U, 1)); | |
| 1481 | if ((l cSuccess = '1') And (loDOJInfo .Count > 1 )) then | |
| 1482 | lcDO J := loDOJ Info[1] | |
| 1483 | else | |
| 1484 | tcEr ror := Tri m(Piece(lo DOJInfo[0] , U, 2)); | |
| 1485 | end; | |
| 1486 | ||
| 1487 | chkSched uleIINarco ticDOJ.Che cked := | |
| 1488 | (Decip horDOJ(lcD OJ, DOJ_SC HDEULE_II_ NARCOTIC) = '1'); | |
| 1489 | chkSched uleIINonNa rcoticDOJ. Checked := | |
| 1490 | (Decip horDOJ(lcD OJ, DOJ_SC HEDULE_II_ NON_NARCOT IC) = '1') ; | |
| 1491 | chkSched uleIIINarc oticDOJ.Ch ecked := | |
| 1492 | (Decip horDOJ(lcD OJ, DOJ_SC HEDULE_III _NARCOTIC) = '1'); | |
| 1493 | chkSched uleIIINonN arcoticDOJ .Checked : = | |
| 1494 | (Decip horDOJ(lcD OJ, DOJ_SC HEDULE_III _NON_NARCO TIC) = '1' ); | |
| 1495 | chkSched uleIVDOJ.C hecked := (DeciphorD OJ(lcDOJ, DOJ_SCHEDU LE_IV) = ' 1'); | |
| 1496 | chkSched uleVDOJ.Ch ecked := ( DeciphorDO J(lcDOJ, D OJ_SCHEDUL E_V) = '1' ); | |
| 1497 | ||
| 1498 | lblProvi derNameDOJ .Caption : = Deciphor DOJ(lcDOJ, DOJ_PROVI DER_NAME) + CRLF + | |
| 1499 | CRLF + BuildDOJA ddress(lcD OJ); | |
| 1500 | ||
| 1501 | lblDetox MaintNumbe rDOJ.Capti on := Deci phorDOJ(lc DOJ, DOJ_D ETOX_NUMBE R); | |
| 1502 | lblDeaEx pirationDa teDOJ.Capt ion := Dec iphorDOJ(l cDOJ, DOJ_ EXPIRATION _DATE); | |
| 1503 | ||
| 1504 | tcInfo : = lcDOJ; | |
| 1505 | end; | |
| 1506 | ||
| 1507 | function T frmMain.Bu ildDOJAddr ess(tcDOJ: String): string; | |
| 1508 | var | |
| 1509 | lcResult : String; | |
| 1510 | lcAdd1, lcAdd2, lc Add3: Stri ng; | |
| 1511 | begin | |
| 1512 | ||
| 1513 | lcResult := ''; | |
| 1514 | lcAdd1 : = Deciphor DOJ(tcDOJ, DOJ_ADDRE SS1); | |
| 1515 | lcAdd2 : = Deciphor DOJ(tcDOJ, DOJ_ADDRE SS2); | |
| 1516 | lcAdd3 : = Deciphor DOJ(tcDOJ, DOJ_ADDRE SS3); | |
| 1517 | if (lcAd d1 <> '') then | |
| 1518 | begin | |
| 1519 | lcResu lt := lcRe sult + lcA dd1 + CRLF ; | |
| 1520 | end; | |
| 1521 | if (lcAd d2 <> '') then | |
| 1522 | begin | |
| 1523 | lcResu lt := lcRe sult + lcA dd2 + CRLF ; | |
| 1524 | end; | |
| 1525 | ||
| 1526 | if (lcAd d3 <> '') then | |
| 1527 | begin | |
| 1528 | lcResu lt := lcRe sult + lcA dd3 + CRLF ; | |
| 1529 | end; | |
| 1530 | ||
| 1531 | lcResult := lcResu lt + Decip horDOJ(tcD OJ, DOJ_CI TY) + ', ' + | |
| 1532 | Deciph orDOJ(tcDO J, DOJ_STA TE) + ' ' + Deciphor DOJ(tcDOJ, DOJ_ZIP_C ODE); | |
| 1533 | ||
| 1534 | Result : = lcResult ; | |
| 1535 | ||
| 1536 | end; | |
| 1537 | ||
| 1538 | function T frmMain.De ciphorDOJ( tcDOJ: Str ing; tnCon st: Intege r): string ; | |
| 1539 | var | |
| 1540 | lcResult , lcTemp: string; | |
| 1541 | loDate: TDateTime; | |
| 1542 | begin | |
| 1543 | ||
| 1544 | lcResult := ''; | |
| 1545 | ||
| 1546 | if ((tnC onst >= DO J_SCHDEULE _II_NARCOT IC) And (t nConst <= DOJ_SCHEDU LE_V)) | |
| 1547 | then | |
| 1548 | begin | |
| 1549 | lcTemp := UpperC ase(Trim(P iece(tcDOJ , U, tnCon st))); | |
| 1550 | if (lc Temp = 'YE S') then | |
| 1551 | lcRe sult := '1 ' | |
| 1552 | else | |
| 1553 | lcRe sult := '0 '; | |
| 1554 | end | |
| 1555 | else if (tnConst = DOJ_EXPIR ATION_DATE ) then | |
| 1556 | begin | |
| 1557 | lcResu lt := Trim (Piece(tcD OJ, U, tnC onst)); | |
| 1558 | if (Le ngth(lcRes ult) = 8) then | |
| 1559 | begin | |
| 1560 | loDa te := StrT oDate(Copy (lcResult, 5, 2) + ' /' + Copy( lcResult, 7, 2) + | |
| 1561 | '/ ' + Copy(l cResult, 1 , 4)); | |
| 1562 | lcRe sult := Fo rmatDateTi me('mmm d, yyyy', lo Date); | |
| 1563 | end | |
| 1564 | else i f (Length( lcResult) = 0) then | |
| 1565 | begin | |
| 1566 | lcRe sult := DO J_EMPTY; | |
| 1567 | end; | |
| 1568 | end | |
| 1569 | else | |
| 1570 | begin | |
| 1571 | lcResu lt := Trim (Piece(tcD OJ, U, tnC onst)); | |
| 1572 | if (lc Result = ' ') then | |
| 1573 | lcRe sult := DO J_EMPTY; | |
| 1574 | end; | |
| 1575 | ||
| 1576 | // Trim is already done in t he above c ode. | |
| 1577 | Result : = lcResult ; | |
| 1578 | end; | |
| 1579 | ||
| 1580 | procedure TfrmMain.u pdateContr olsOnSelec t(tlAddReq uest: Bool ean; | |
| 1581 | tnIndex: Integer); | |
| 1582 | var | |
| 1583 | lcDEA: s tring; | |
| 1584 | begin | |
| 1585 | ||
| 1586 | edtDEASu ffix.Text := ''; | |
| 1587 | fmcbxUse Inpatient. Enabled := True; | |
| 1588 | ||
| 1589 | if (tlAd dRequest) then | |
| 1590 | begin | |
| 1591 | fmedtD eaNumber.T ext := ''; | |
| 1592 | fmedtD etoxMaintN umber.Text := getCur rentInform ation(tnIn dex, DETOX ); | |
| 1593 | ||
| 1594 | fmedtD eaExpirati onDate.Tex t := getCu rrentInfor mation(tnI ndex, EXPI RATION); | |
| 1595 | ||
| 1596 | fmcbxS cheduleIIN arcotic.Ch ecked := | |
| 1597 | (get CurrentInf ormation(t nIndex, SC HEDULE_II_ NARCOTIC) = '1'); | |
| 1598 | fmcbxS cheduleIIN onNarcotic .Checked : = | |
| 1599 | (get CurrentInf ormation(t nIndex, SC HEDULE_II_ NON_NARCOT IC) = '1') ; | |
| 1600 | fmcbxS cheduleIII Narcotic.C hecked := | |
| 1601 | (get CurrentInf ormation(t nIndex, SC HEDULE_III _NARCOTIC) = '1'); | |
| 1602 | fmcbxS cheduleIII NonNarcoti c.Checked := | |
| 1603 | (get CurrentInf ormation(t nIndex, SC HEDULE_III _NON_NARCO TIC) = '1' ); | |
| 1604 | fmcbxS cheduleIV. Checked := | |
| 1605 | (get CurrentInf ormation(t nIndex, SC HEDULE_IV) = '1'); | |
| 1606 | fmcbxS cheduleV.C hecked := | |
| 1607 | (get CurrentInf ormation(t nIndex, SC HEDULE_V) = '1'); | |
| 1608 | ||
| 1609 | fmcbxU seInpatien t.Checked := | |
| 1610 | (get CurrentInf ormation(t nIndex, IN PATIENT) = '1'); | |
| 1611 | ||
| 1612 | // DOJ component s | |
| 1613 | BlankD OJFields() ; | |
| 1614 | ||
| 1615 | setEna ble(fmedtD eaNumber, True); | |
| 1616 | ||
| 1617 | btnCop y.Enabled := True; | |
| 1618 | ||
| 1619 | btnRem ove.Enable d := False ; | |
| 1620 | btnUpd ate.Enable d := False ; | |
| 1621 | end | |
| 1622 | else | |
| 1623 | begin | |
| 1624 | setEna ble(fmedtD eaNumber, False); | |
| 1625 | ||
| 1626 | btnCop y.Enabled := False; | |
| 1627 | ||
| 1628 | btnRem ove.Enable d := True; | |
| 1629 | btnUpd ate.Enable d := True; | |
| 1630 | ||
| 1631 | lcDEA := getCurr entInforma tion(tnInd ex, DEA); | |
| 1632 | // If contains a suffix, t hen user c an not set the Inpat ient Order s. | |
| 1633 | fmcbxU seInpatien t.Enabled := Not Con tainsText( lcDEA, '-' ); | |
| 1634 | end; | |
| 1635 | ||
| 1636 | btnAdd.E nabled := False; | |
| 1637 | ||
| 1638 | setEnabl e(edtDEASu ffix, Fals e); | |
| 1639 | ||
| 1640 | end; | |
| 1641 | ||
| 1642 | function T frmMain.ge tCurrentIn formation( tnIndex: I nteger; | |
| 1643 | tnConst: Integer): string; | |
| 1644 | var | |
| 1645 | lcResult , lcSuffix , lcIndex, lcTemp: s tring; | |
| 1646 | llAddReq uest: Bool ean; | |
| 1647 | begin | |
| 1648 | ||
| 1649 | lcResult := ''; | |
| 1650 | lcIndex := foPresc riberDEALi st[tnIndex ]; | |
| 1651 | llAddReq uest := (l cIndex = A DD_DEA); | |
| 1652 | ||
| 1653 | if (Not llAddReque st) then | |
| 1654 | begin | |
| 1655 | if (tn Const = DE A) then | |
| 1656 | begin | |
| 1657 | lcRe sult := Tr im(Piece(l cIndex, U, DEA)); | |
| 1658 | lcSu ffix := Tr im(Piece(l cIndex, U, SUFFIX)); | |
| 1659 | if ( Length(lcS uffix) > 0 ) then | |
| 1660 | lc Result := lcResult + '-' + lcS uffix; | |
| 1661 | end | |
| 1662 | else i f (((tnCon st >= SCHE DULE_II_NA RCOTIC) An d (tnConst <= SCHEDU LE_V)) OR | |
| 1663 | (tnC onst = INP ATIENT)) t hen | |
| 1664 | begin | |
| 1665 | lcTe mp := Uppe rCase(Trim (Piece(lcI ndex, U, t nConst))); | |
| 1666 | if ( lcTemp = ' YES') then | |
| 1667 | lc Result := '1' | |
| 1668 | else | |
| 1669 | lc Result := '0'; | |
| 1670 | end | |
| 1671 | else | |
| 1672 | begin | |
| 1673 | lcRe sult := Tr im(Piece(l cIndex, U, tnConst)) ; | |
| 1674 | end; | |
| 1675 | ||
| 1676 | end; | |
| 1677 | ||
| 1678 | if ((llA ddRequest) And (tnCo nst = DNIE NS)) then | |
| 1679 | begin | |
| 1680 | // Fro m the help documenta tion on IE NS. | |
| 1681 | if (lc Result = ' ') then | |
| 1682 | lcRe sult := IE NS_ADD; | |
| 1683 | end; | |
| 1684 | ||
| 1685 | Result : = lcResult ; | |
| 1686 | end; | |
| 1687 | ||
| 1688 | procedure TfrmMain.U pdateRCPVa riables(); | |
| 1689 | begin | |
| 1690 | ||
| 1691 | with fCu rrentPresc riber do | |
| 1692 | begin | |
| 1693 | Author izedToWrit e := fmcbx Authorized ToWriteOrd ers.Checke d; | |
| 1694 | Subjec tAlternate Name := fm edtAltName .FMCtrlInt ernal; | |
| 1695 | ||
| 1696 | DEA := fmedtDeaN umber.FMCt rlInternal ; | |
| 1697 | ||
| 1698 | VANumb er := fmed tVANumber. FMCtrlInte rnal; | |
| 1699 | DetoxN umber := f medtDetoxM aintNumber .FMCtrlInt ernal; | |
| 1700 | DEAExp irationDat e := fmedt DeaExpirat ionDate.FM CtrlIntern al; | |
| 1701 | ||
| 1702 | // A b lank from fileman is used as F alse | |
| 1703 | AllowS cheduleIIN arc := fmc bxSchedule IINarcotic .Checked; | |
| 1704 | AllowS cheduleIIN onNarc := fmcbxSched uleIINonNa rcotic.Che cked; | |
| 1705 | AllowS cheduleIII Narc := fm cbxSchedul eIIINarcot ic.Checked ; | |
| 1706 | AllowS cheduleIII NonNarc := fmcbxSche duleIIINon Narcotic.C hecked; | |
| 1707 | AllowS cheduleIVN arc := fmc bxSchedule IV.Checked ; | |
| 1708 | AllowS cheduleVNa rc := fmcb xScheduleV .Checked; | |
| 1709 | ||
| 1710 | UseFor Inpatient := fmcbxUs eInpatient .Checked; | |
| 1711 | end; | |
| 1712 | ||
| 1713 | end; | |
| 1714 | ||
| 1715 | procedure TfrmMain.f mcbxSchedu leClick(Se nder: TObj ect); | |
| 1716 | // If we u ncheck eve n one of t he schedul es then we need to m ake sure t hat the al l checkbox is off | |
| 1717 | begin | |
| 1718 | if not T FMCheckBox (Sender).C hecked the n | |
| 1719 | cbxAll Schedules. Checked := False; | |
| 1720 | end; | |
| 1721 | ||
| 1722 | procedure TfrmMain.f mcbxUseInp atientClic k(Sender: TObject); | |
| 1723 | var | |
| 1724 | i, lnCou nt: Intege r; | |
| 1725 | lcDEA, l cCurrentDE A, lcLine: String; | |
| 1726 | llInpati entUse, ll Okay: Bool ean; | |
| 1727 | loCheckB ox: TFMChe ckBox; | |
| 1728 | ||
| 1729 | begin | |
| 1730 | // Geesh , there's not other way around this. Cli ck is fire d anytime | |
| 1731 | // the c heckbox va lue is cha nged, not just when clicked. | |
| 1732 | if (Not flValidate OnClickUse InpatientO rder) Then | |
| 1733 | Exit; | |
| 1734 | ||
| 1735 | lcCurren tDEA := Tr im(fmedtDe aNumber.Te xt); | |
| 1736 | ||
| 1737 | loCheckB ox := (Sen der As TFM CheckBox); | |
| 1738 | // Remem ber, this event is a lso fired when the c heckbox.ch ecked is | |
| 1739 | // chang ed program matically. | |
| 1740 | if (loCh eckBox.Ena bled) then | |
| 1741 | begin | |
| 1742 | if ((N ot loCheck Box.Checke d) And (Co untValidDE ANumbers < = 1) And | |
| 1743 | (lcC urrentDEA <> '')) th en | |
| 1744 | begin | |
| 1745 | // P revents re cursion fr om happeni ng. You mu st change the TCheck Box | |
| 1746 | // b efore the dialog box , by the w ay, to giv e time for the click | |
| 1747 | // e vent to be fired. | |
| 1748 | flVa lidateOnCl ickUseInpa tientOrder := False; | |
| 1749 | loCh eckBox.Che cked := Tr ue; | |
| 1750 | ||
| 1751 | Show Msg('DEA# ' + lcDEA + ' is the only one and must r emain sele cted.', | |
| 1752 | sm iError, sm bOK); | |
| 1753 | ||
| 1754 | flVa lidateOnCl ickUseInpa tientOrder := True; | |
| 1755 | Exit ; | |
| 1756 | end; | |
| 1757 | end; | |
| 1758 | ||
| 1759 | llOkay : = True; | |
| 1760 | lnCount := foPresc riberDEALi st.Count; | |
| 1761 | ||
| 1762 | for i := 0 to lnCo unt - 1 do | |
| 1763 | begin | |
| 1764 | lcLine := foPres criberDEAL ist[i]; | |
| 1765 | if (lc Line <> AD D_DEA) the n | |
| 1766 | begin | |
| 1767 | lcDE A := getCu rrentInfor mation(i, DEA); | |
| 1768 | llIn patientUse := getCur rentInform ation(i, I NPATIENT) = '1'; | |
| 1769 | ||
| 1770 | if ( llInpatien tUse) then | |
| 1771 | begi n | |
| 1772 | ll Okay := (l cCurrentDE A = lcDEA) ; | |
| 1773 | br eak; | |
| 1774 | end; | |
| 1775 | end; | |
| 1776 | ||
| 1777 | end; | |
| 1778 | ||
| 1779 | if (Not llOkay) th en | |
| 1780 | begin | |
| 1781 | // Pre vents recu rsion from happening . You must change th e TCheckBo x | |
| 1782 | // bef ore the di alog box, by the way , to give time for t he click | |
| 1783 | // eve nt to be f ired. | |
| 1784 | flVali dateOnClic kUseInpati entOrder : = False; | |
| 1785 | loChec kBox.Check ed := Fals e; | |
| 1786 | ||
| 1787 | ShowMs g('DEA# ' + lcDEA + | |
| 1788 | ' ha s already selected ' 'Use for I npatient O rders?''', smiError, smbOK); | |
| 1789 | ||
| 1790 | flVali dateOnClic kUseInpati entOrder : = True; | |
| 1791 | end; | |
| 1792 | ||
| 1793 | end; | |
| 1794 | ||
| 1795 | function T frmMain.Co untValidDE ANumbers() : Integer; | |
| 1796 | var | |
| 1797 | i, lnCou nt, lnDEAC ount: Inte ger; | |
| 1798 | lcDEA, l cLine: Str ing; | |
| 1799 | begin | |
| 1800 | ||
| 1801 | lnCount := foPresc riberDEALi st.Count; | |
| 1802 | lnDEACou nt := 0; | |
| 1803 | ||
| 1804 | for i := 0 to lnCo unt - 1 do | |
| 1805 | begin | |
| 1806 | lcLine := foPres criberDEAL ist[i]; | |
| 1807 | if (lc Line <> AD D_DEA) the n | |
| 1808 | begin | |
| 1809 | lcDE A := getCu rrentInfor mation(i, DEA); | |
| 1810 | if ( Pos('-', l cDEA) = 0) then | |
| 1811 | begi n | |
| 1812 | ln DEACount : = lnDEACou nt + 1; | |
| 1813 | end; | |
| 1814 | end; | |
| 1815 | ||
| 1816 | end; | |
| 1817 | ||
| 1818 | Result : = lnDEACou nt; | |
| 1819 | end; | |
| 1820 | ||
| 1821 | procedure TfrmMain.C heckInpati entWarning (); | |
| 1822 | var | |
| 1823 | i, lnCou nt: Intege r; | |
| 1824 | lcLine: String; | |
| 1825 | llInpati entUse: Bo olean; | |
| 1826 | lcDEA: S tring; | |
| 1827 | begin | |
| 1828 | lnCount := foPresc riberDEALi st.Count; | |
| 1829 | // Since there mig ht only be the ADD_D EA option, set to tr ue. | |
| 1830 | llInpati entUse := True; | |
| 1831 | ||
| 1832 | for i := 0 to lnCo unt - 1 do | |
| 1833 | begin | |
| 1834 | lcLine := foPres criberDEAL ist[i]; | |
| 1835 | // In this loop, I can't q uery the D OJ files f or institu tional DEA . Well, ma ybe I coul d, | |
| 1836 | // but it would be convolu ted. And a ll institu tional DEA #s have a dash and suffix. | |
| 1837 | lcDEA := getCurr entInforma tion(i, DE A); | |
| 1838 | if ((l cLine <> A DD_DEA) An d (Pos('-' , lcDEA) = 0)) then | |
| 1839 | begin | |
| 1840 | llIn patientUse := (getCu rrentInfor mation(i, INPATIENT) = '1'); | |
| 1841 | ||
| 1842 | // O nce the ch ecked DEA has been f ound, then exit. | |
| 1843 | if ( llInpatien tUse) then | |
| 1844 | br eak; | |
| 1845 | end; | |
| 1846 | ||
| 1847 | end; | |
| 1848 | ||
| 1849 | lblInpat ientWarnin g.Visible := Not llI npatientUs e; | |
| 1850 | btnSelec tPrescribe r.Enabled := llInpat ientUse; | |
| 1851 | end; | |
| 1852 | ||
| 1853 | function T frmMain.Ge tFacilityV ANum(IENS: string): string; | |
| 1854 | var | |
| 1855 | Ival: In teger; | |
| 1856 | aFacilit yIen: stri ng; | |
| 1857 | begin | |
| 1858 | Result : = ''; | |
| 1859 | memUtili ty.Clear; | |
| 1860 | fmLister NewPersonD ivision.IE NS := ',' + IENS; | |
| 1861 | ||
| 1862 | fmLister NewPersonD ivision.Ge tList(memU tility.Lin es); | |
| 1863 | aFacilit yIen := '' ; | |
| 1864 | for Ival := 1 to m emUtility. Lines.Coun t do | |
| 1865 | begin | |
| 1866 | if Pos (' 1', mem Utility.Li nes[Ival - 1]) > 0 t hen | |
| 1867 | begin | |
| 1868 | aFac ilityIen : = memUtili ty.Lines[I val - 1]; | |
| 1869 | aFac ilityIen : = Copy(aFa cilityIen, 1, Length (aFacility Ien) - 2); | |
| 1870 | end; | |
| 1871 | end; | |
| 1872 | if (aFac ilityIen = '') and ( memUtility .Lines.Cou nt = 1) th en | |
| 1873 | begin | |
| 1874 | aFacil ityIen := memUtility .Lines[0]; | |
| 1875 | if Pos (' 0', aFa cilityIen) > 0 then | |
| 1876 | aFac ilityIen : = Copy(aFa cilityIen, 1, Length (aFacility Ien) - 2); | |
| 1877 | end; | |
| 1878 | if not(a FacilityIe n = '') th en | |
| 1879 | begin | |
| 1880 | while Copy(aFaci lityIen, L ength(aFac ilityIen), 1) = ' ' do | |
| 1881 | aFac ilityIen : = Copy(aFa cilityIen, 1, Length (aFacility Ien) - 1); | |
| 1882 | Result := Piece( GetValueFr omVistA('$ G(^DIC(4,' + aFacili tyIen + | |
| 1883 | ',"D EA"))'), ' ^'); | |
| 1884 | if not (Result = '') then | |
| 1885 | Exit ; | |
| 1886 | end; | |
| 1887 | // No Di vision or Couldn't g et Facilit y DEA Numb er for Div ision | |
| 1888 | aFacilit yIen := Ge tValueFrom VistA('$G( junk,$$SIT E^VASITE() )'); | |
| 1889 | aFacilit yIen := Pi ece(aFacil ityIen, '^ '); | |
| 1890 | if not(a FacilityIe n = '') th en | |
| 1891 | begin | |
| 1892 | Result := Piece( GetValueFr omVistA('$ G(^DIC(4,' + aFacili tyIen + | |
| 1893 | ',"D EA"))'), ' ^') | |
| 1894 | end; | |
| 1895 | end; | |
| 1896 | ||
| 1897 | function T frmMain.Ge tValueFrom VistA(Inpu tStr: stri ng): strin g; | |
| 1898 | begin | |
| 1899 | with RPC Broker do | |
| 1900 | try | |
| 1901 | Remo teProcedur e := 'XWB GET VARIAB LE VALUE'; | |
| 1902 | Para m[0].Value := InputS tr; | |
| 1903 | Para m[0].PType := Refere nce; | |
| 1904 | Call ; | |
| 1905 | if ( Results.Co unt > 0) t hen | |
| 1906 | Re sult := Re sults[0] | |
| 1907 | else | |
| 1908 | Re sult := '' ; | |
| 1909 | except | |
| 1910 | Resu lt := ''; | |
| 1911 | end; | |
| 1912 | end; | |
| 1913 | ||
| 1914 | end. |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.