Module

fODMedNVA

Path

C:\CPRS\CPRS30\Orders\fODMedNVA.pas

Last Modified

7/15/2014 3:26:42 PM

Units Used in Interface

Name Comments
fODBase -
rMisc -
uConst -
uOrders -
XuDigSigSC_TLB -

Units Used in Implementation

Name Comments
fFrame -
fODMedOIFA -
fRptBox -
rCore -
rODBase -
rODMeds -
rOrders -
uCore -

Classes

Name Comments
TfrmODMedNVA -

Procedures

Name Owner Declaration Scope Comments
btnSelectClick TfrmODMedNVA procedure btnSelectClick(Sender: TObject); Public/Published
Medication is now selected ---------------------------------------------------------------- 

MedName: string;
cboDosageChange TfrmODMedNVA procedure cboDosageChange(Sender: TObject); Public/Published -
cboDosageClick TfrmODMedNVA procedure cboDosageClick(Sender: TObject); Public/Published -
cboDosageExit TfrmODMedNVA procedure cboDosageExit(Sender: TObject); Public/Published -
cboDosageKeyUp TfrmODMedNVA procedure cboDosageKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
cboRouteChange TfrmODMedNVA procedure cboRouteChange(Sender: TObject); Public/Published CboRoute --------------------------------------
cboRouteKeyUp TfrmODMedNVA procedure cboRouteKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
cboScheduleChange TfrmODMedNVA procedure cboScheduleChange(Sender: TObject); Public/Published -
cboScheduleClick TfrmODMedNVA procedure cboScheduleClick(Sender: TObject); Public/Published CboSchedule -----------------------------------
cboScheduleKeyUp TfrmODMedNVA procedure cboScheduleKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
ChangeDelayed TfrmODMedNVA procedure ChangeDelayed; Private Selection
CheckAuthForNVAMeds - procedure CheckAuthForNVAMeds(var x: string); Interfaced -
CheckDecimal TfrmODMedNVA procedure CheckDecimal(var AStr: string); Public -
CheckFormAltDose TfrmODMedNVA procedure CheckFormAltDose(DispDrug: Integer); Private CboDosage -------------------------------------
chkPRNClick TfrmODMedNVA procedure chkPRNClick(Sender: TObject); Public/Published -
cmdAcceptClick TfrmODMedNVA procedure cmdAcceptClick(Sender: TObject); Public/Published -
ControlChange TfrmODMedNVA procedure ControlChange(Sender: TObject); Public/Published -
DispOrderMessage TfrmODMedNVA procedure DispOrderMessage(const AMessage: string); Public/Published -
FindInCombo - procedure FindInCombo(const x: string; AComboBox: TORComboBox); Global General Functions - get & set cell values
FormCreate TfrmODMedNVA procedure FormCreate(Sender: TObject); Public/Published Procedures inherited from fODBase ---------------------------------------------------------
FormDestroy TfrmODMedNVA procedure FormDestroy(Sender: TObject); Public/Published -
FormKeyPress TfrmODMedNVA procedure FormKeyPress(Sender: TObject; var Key: Char); Public/Published -
FormResize TfrmODMedNVA procedure FormResize(Sender: TObject); Public/Published -
grdDosesEnter TfrmODMedNVA procedure grdDosesEnter(Sender: TObject); Public/Published -
grdDosesExit TfrmODMedNVA procedure grdDosesExit(Sender: TObject); Public/Published -
grdDosesKeyDown TfrmODMedNVA procedure grdDosesKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
InitDialog TfrmODMedNVA procedure InitDialog; override; Protected Executed each time dialog is reset after pressing accept. Clears controls & responses
KillDrug - procedure KillDrug(const ADrug: string); Local -
lblGuidelineClick TfrmODMedNVA procedure lblGuidelineClick(Sender: TObject); Public/Published -
lbStatementsClickCheck TfrmODMedNVA procedure lbStatementsClickCheck(Sender: TObject; Index: Integer); Public/Published -
ListViewClick TfrmODMedNVA procedure ListViewClick(Sender: TObject); Public/Published -
ListViewEditing TfrmODMedNVA procedure ListViewEditing(Sender: TObject; Item: TListItem; var AllowEdit: Boolean); Public/Published -
ListViewEnter TfrmODMedNVA procedure ListViewEnter(Sender: TObject); Public/Published LstAll & lstQuick methods
ListViewResize TfrmODMedNVA procedure ListViewResize(Sender: TObject); Public/Published -
LoadNonVAMedCache TfrmODMedNVA procedure LoadNonVAMedCache(First, Last: Integer); Private Cache is a list of 100 string lists, starting at idx 0
LoadOTCStatements TfrmODMedNVA procedure LoadOTCStatements(Dest: TStrings); Private NON VA MEDS
lstAllData TfrmODMedNVA procedure lstAllData(Sender: TObject; Item: TListItem); Public/Published -
lstAllDataHint TfrmODMedNVA procedure lstAllDataHint(Sender: TObject; StartIndex, EndIndex: Integer); Public/Published -
lstChange TfrmODMedNVA procedure lstChange(Sender: TObject; Item: TListItem; Change: TItemChange); Public/Published -
lstQuickData TfrmODMedNVA procedure lstQuickData(Sender: TObject; Item: TListItem); Public/Published -
memMessageKeyDown TfrmODMedNVA procedure memMessageKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
pnlMessageEnter TfrmODMedNVA procedure pnlMessageEnter(Sender: TObject); Public/Published -
pnlMessageExit TfrmODMedNVA procedure pnlMessageExit(Sender: TObject); Public/Published -
ResetOnMedChange TfrmODMedNVA procedure ResetOnMedChange; Private Edit
RestoreCancelButton TfrmODMedNVA procedure RestoreCancelButton; Private -
RestoreDefaultButton TfrmODMedNVA procedure RestoreDefaultButton; Private -
SaveDrug - procedure SaveDrug(const ADrug: string; UnitsPerDose: Extended); Local -
ScrollToVisible TfrmODMedNVA procedure ScrollToVisible(AListView: TListView); Private -
SetDosage TfrmODMedNVA procedure SetDosage(const x: string); Private -
SetError - procedure SetError(const x: string); Local -
SetOnMedSelect TfrmODMedNVA procedure SetOnMedSelect; Private -
SetOnQuickOrder TfrmODMedNVA procedure SetOnQuickOrder; Private -
SetSchedule TfrmODMedNVA procedure SetSchedule(const x: string); Private -
SetStartDate TfrmODMedNVA procedure SetStartDate(const x: string); Private -
SetStatements TfrmODMedNVA procedure SetStatements(x: string); Private -
SetupDialog TfrmODMedNVA procedure SetupDialog(OrderAction: Integer; const ID: string); override; Public AnInstr: string;
ShowControlsSimple TfrmODMedNVA procedure ShowControlsSimple; Private -
ShowMedFields TfrmODMedNVA procedure ShowMedFields; Private -
ShowMedSelect TfrmODMedNVA procedure ShowMedSelect; Private -
StartKeyTimer TfrmODMedNVA procedure StartKeyTimer; Private Start (or restart) a timer (done on keyup to delay before calling OnKeyPause)
StopKeyTimer TfrmODMedNVA procedure StopKeyTimer; Private Stop the timer (done whenever a key is pressed or the combobox no longer has focus)
tabDoseChange TfrmODMedNVA procedure tabDoseChange(Sender: TObject); Public/Published Medication edit ---------------------------------------------------------------------------
timCheckChangesTimer TfrmODMedNVA procedure timCheckChangesTimer(Sender: TObject); Public/Published -
txtMedChange TfrmODMedNVA procedure txtMedChange(Sender: TObject); Public/Published -
txtMedExit TfrmODMedNVA procedure txtMedExit(Sender: TObject); Public/Published -
txtMedKeyDown TfrmODMedNVA procedure txtMedKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
txtMedKeyUp TfrmODMedNVA procedure txtMedKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
UMDelayClick TfrmODMedNVA procedure UMDelayClick(var Message: TMessage); message UM_DELAYCLICK; Private -
UpdateRelated TfrmODMedNVA procedure UpdateRelated(DelayUpdate: Boolean = TRUE); Private -
UpdateStartExpires TfrmODMedNVA procedure UpdateStartExpires(const CurSchedule: string); Private -
Validate TfrmODMedNVA procedure Validate(var AnErrMsg: string); override; Protected -
ValidateDosage - procedure ValidateDosage(const x: string); Local -
ValidateRoute - procedure ValidateRoute(const x: string; NeedLookup: Boolean; AnInstance: Integer); Local -
ValidateSchedule - procedure ValidateSchedule(const x: string; AnInstance: Integer); Local -
WMTimer TfrmODMedNVA procedure WMTimer(var Message: TWMTimer); message WM_TIMER; Private TxtMed methods (including timers)

Functions

Name Owner Declaration Scope Comments
ConstructedDoseFields TfrmODMedNVA function ConstructedDoseFields(const ADose: string; PrependName: Boolean = FALSE): string; Private -
DisableCancelButton TfrmODMedNVA function DisableCancelButton(Control: TWinControl): boolean; Private -
DisableDefaultButton TfrmODMedNVA function DisableDefaultButton(Control: TWinControl): boolean; Private -
FindCommonDrug TfrmODMedNVA function FindCommonDrug(DoseList: TStringList): string; Private DoseList[n] = DoseText ^ Dispense Drug Pointer
FindDoseFields TfrmODMedNVA function FindDoseFields(const Drug, ADose: string): string; Private -
FindQuickOrder TfrmODMedNVA function FindQuickOrder(const x: string): Integer; Private -
GetCacheChunkIndex TfrmODMedNVA function GetCacheChunkIndex(idx: integer): integer; Private -
GetSchedule - function GetSchedule: string; Local
The following functions were created to get rid of a compile warning saying the
 return value may be undefined - too much branching logic in the case statements
 for the compiler to handle
GetScheduleEX - function GetScheduleEX: string; Local -
isUniqueQuickOrder TfrmODMedNVA function isUniqueQuickOrder(iText: string): Boolean; Private -
OIForNVA - function OIForNVA(AnIEN: Integer; ForNonVAMed: Boolean; HavePI: boolean = True; PKIActive: Boolean = False): TStrings; Interfaced -
OutpatientSig TfrmODMedNVA function OutpatientSig: string; Private Values changing
SearchStatements TfrmODMedNVA function SearchStatements(StatementList:TStringList;Statement: string): Boolean; Private -
ValueOf TfrmODMedNVA function ValueOf(FieldID: Integer; ARow: Integer = -1): string; Private
Contents of cboDosage
    DrugName^Strength^NF^TDose&Units&U/D&Noun&LDose&Drug^DoseText^CostText^MaxRefills
  Contents of grid cells  (Only the first tab piece for each cell is drawn)
    Dosage    <TAB> DosageFields
    RouteText <TAB> IEN^RouteName^Abbreviation
    Schedule  <TAB> (nothing)
    Duration  <TAB> Duration^Units 






 the following functions were created to get rid of a compile warning saying the
 return value may be undefined - too much branching logic in the case statements
 for the compiler to handle
ValueOfResponse TfrmODMedNVA function ValueOfResponse(FieldID: Integer; AnInstance: Integer = 1): string; Private -

Global Variables

Name Type Declaration Comments
crypto crypto: IXuDigSigS; -
frmODMedNVA TfrmODMedNVA frmODMedNVA: TfrmODMedNVA; -

Constants

Name Declaration Scope Comments
COL_DOSAGE 1 Global -
COL_DURATION 4 Global -
COL_ROUTE 2 Global -
COL_SCHEDULE 3 Global -
COL_SELECT 0 Global Grid columns for complex dosing
COL_SEQUENCE 5 Global -
FLD_ANDTHEN 73 Global -
FLD_COMMENT 80 Global -
FLD_DOSEFLDS 5 Global -
FLD_DOSETEXT 8 Global -
FLD_DOSEUNIT 11 Global -
FLD_DRUG_ID 3 Global -
FLD_DRUG_NM 4 Global -
FLD_DURATION 30 Global -
FLD_EXPIRE 72 Global -
FLD_INSTRUCT 10 Global -
FLD_LOCALDOSE 1 Global Field identifiers
FLD_MISC_FLDS 50 Global -
FLD_NOW_ID 75 Global -
FLD_NOW_NM 76 Global -
FLD_PICKUP 55 Global -
FLD_PRIOR_ID 60 Global -
FLD_PRIOR_NM 61 Global -
FLD_PTINSTR 85 Global -
FLD_QTYDISP 56 Global -
FLD_QUANTITY 52 Global -
FLD_REFILLS 53 Global -
FLD_ROUTE_AB 17 Global -
FLD_ROUTE_EX 18 Global -
FLD_ROUTE_ID 15 Global -
FLD_ROUTE_NM 16 Global -
FLD_SC 58 Global -
FLD_SCHED_EX 21 Global -
FLD_SCHED_TYP 22 Global -
FLD_SCHEDULE 20 Global -
FLD_SEQUENCE 31 Global -
FLD_START 88 Global -
FLD_START_ID 70 Global -
FLD_START_NM 71 Global -
FLD_STATEMENTS 90 Global -
FLD_STRENGTH 2 Global -
FLD_SUPPLY 51 Global -
FLD_TOTALDOSE 7 Global -
FLD_UNITNOUN 6 Global -
MED_CACHE_CHUNK_SIZE 100 Global -
NVA_CR #13 Interfaced -
NVA_LF #10 Interfaced -
TAB #9 Global -
TC_GUIDELINE 'Restrictions/Guidelines' Global -
TC_NO_DEA 'DEA# Required' Global -
TC_RESTRICT 'Ordering Restrictions' Global -
TI_COMPLEX 1 Global -
TI_DOSE 0 Global Dosage type tab index values
TI_RATE 99 Global -
TIMER_DELAY 500 Global 500 millisecond delay
TIMER_FROM_DAYS 1 Global -
TIMER_FROM_QTY 2 Global -
TIMER_ID 6902 Global
Misc constants

 arbitrary number
TX_ADMIN 'Requested Start: ' Global Text constants
TX_BAD_DATE 'Dates must be in the format mm/dd/yy or mm/yy' Global -
TX_CAP_FUTURE 'Invalid date' Global -
TX_DOSE_LEN 'Dosage may not exceed 60 characters' Global -
TX_DOSE_NUM 'Dosage may not be numeric only' Global -
TX_FUTUREDT 'Dates in the future are not allowed.' Global Cla 7-17-03
TX_MAX_STOP 'The maximum expiration for this order is ' Global -
TX_NF_ROUTE 'Route not found in the Medication Routes file.' Global -
TX_NO_DEA 'Provider must have a DEA# or VA# to order this medication' Global -
TX_NO_DOSE 'Dosage must be entered.' Global -
TX_NO_FUTURE_DATES 'Dates in the future are not allowed.' Global -
TX_NO_MED 'Medication must be selected.' Global -
TX_NO_PICK 'A method for picking up the medication must be entered.' Global -
TX_NO_ROUTE 'Route must be entered.' Global -
TX_NO_SCHED 'Schedule must be entered.' Global -
TX_OUTPT_IV 'This patient has not been admitted. Only IV orders may be entered.' Global -
TX_QTY_MAIL 'Quantity for mailed items must be a whole number.' Global -
TX_QTY_NV 'Unable to validate quantity.' Global -
TX_QTY_POST ' <<' Global -
TX_QTY_PRE '>> Quantity Dispensed: ' Global -
TX_RNG_REFILL 'The number of refills must be in the range of 0 through ' Global -
TX_SCH_LEN 'Schedule must be less than 70 characters.' Global -
TX_SCH_LSP 'Schedule may not have leading spaces.' Global -
TX_SCH_MINUS 'Schedule must not have a dash at the beginning.' Global -
TX_SCH_NS 'Unable to resolve non-standard schedule.' Global -
TX_SCH_PRN 'Schedule cannot include PRN - use Comments to enter PRN.' Global -
TX_SCH_QUOTE 'Schedule must not have quotemarks in it.' Global -
TX_SCH_SPACE 'Schedule must have only one space in it.' Global -
TX_SCH_ZERO 'Schedule cannot be Q0' Global -
TX_STARTDT 'Unable to interpret start date.' Global Cla 7-17-03
TX_SUPPLY_LIM 'Days Supply may not be greater than 90.' Global -
TX_SUPPLY_LIM1 'Days Supply may not be less than 1.' Global -
TX_SUPPLY_NINT 'Days Supply is an invalid number.' Global -
TX_TAKE '' Global -
UM_DELAYCLICK 11037 Interfaced Temporary for listview click event
VAL_DOSAGE 10 Global -
VAL_DURATION 40 Global -
VAL_ROUTE 20 Global -
VAL_SCHEDULE 30 Global -
VAL_SEQUENCE 50 Global -


Module Source

1     unit fODMedNVA;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       fODBase, StdCtrls, ComCtrls, ExtCtrls, ORCtrls, Grids, Buttons, uConst, ORDtTm,
8       Menus, XuDigSigSC_TLB, rMisc, uOrders, StrUtils, oRFn, contnrs,
9       VA508AccessibilityManager;
10    
11    const
12      UM_DELAYCLICK = 11037;  // temporary for listview click event
13      NVA_CR = #13;
14      NVA_LF = #10;
15    
16    type
17      TfrmODMedNVA = class(TfrmODBase)
18        txtMed: TEdit;
19        pnlMeds: TPanel;
20        lstQuick: TCaptionListView;
21        sptSelect: TSplitter;
22        lstAll: TCaptionListView;
23        dlgStart: TORDateTimeDlg;
24        timCheckChanges: TTimer;
25        pnlFields: TPanel;
26        pnlTop: TPanel;
27        lblRoute: TLabel;
28        lblSchedule: TLabel;
29        lblGuideline: TStaticText;
30        tabDose: TTabControl;
31        cboDosage: TORComboBox;
32        cboRoute: TORComboBox;
33        cboSchedule: TORComboBox;
34        chkPRN: TCheckBox;
35        pnlBottom: TPanel;
36        lblComment: TLabel;
37        memComment: TCaptionMemo;
38        lblAdminTime: TStaticText;
39        calStart: TORDateBox;
40        Label1: TLabel;
41        lbStatements: TORListBox;
42        Label2: TLabel;
43        btnSelect: TButton;
44        Image1: TImage;
45        memDrugMsg: TMemo;
46        procedure FormCreate(Sender: TObject);
47        procedure btnSelectClick(Sender: TObject);
48        procedure tabDoseChange(Sender: TObject);
49        procedure FormDestroy(Sender: TObject);
50        procedure txtMedKeyDown(Sender: TObject; var Key: Word;
51          Shift: TShiftState);
52        procedure txtMedKeyUp(Sender: TObject; var Key: Word;
53          Shift: TShiftState);
54        procedure txtMedChange(Sender: TObject);
55        procedure txtMedExit(Sender: TObject);
56        procedure ListViewEditing(Sender: TObject; Item: TListItem;
57          var AllowEdit: Boolean);
58        procedure ListViewResize(Sender: TObject);
59        procedure lstQuickData(Sender: TObject; Item: TListItem);
60        procedure lstAllDataHint(Sender: TObject; StartIndex,
61          EndIndex: Integer);
62        procedure lstAllData(Sender: TObject; Item: TListItem);
63        procedure lblGuidelineClick(Sender: TObject);
64        procedure ListViewClick(Sender: TObject);
65        procedure cboScheduleChange(Sender: TObject);
66        procedure cboRouteChange(Sender: TObject);
67        procedure ControlChange(Sender: TObject);
68        procedure cboDosageClick(Sender: TObject);
69        procedure cboDosageChange(Sender: TObject);
70        procedure cboScheduleClick(Sender: TObject);
71        procedure DispOrderMessage(const AMessage: string);
72    
73    
74        procedure grdDosesExit(Sender: TObject);
75        procedure ListViewEnter(Sender: TObject);
76        procedure timCheckChangesTimer(Sender: TObject);
77        procedure cmdAcceptClick(Sender: TObject);
78        procedure cboDosageExit(Sender: TObject);
79        procedure chkPRNClick(Sender: TObject);
80        procedure grdDosesKeyDown(Sender: TObject; var Key: Word;
81          Shift: TShiftState);
82        procedure grdDosesEnter(Sender: TObject);
83        procedure pnlMessageEnter(Sender: TObject);
84        procedure pnlMessageExit(Sender: TObject);
85        procedure memMessageKeyDown(Sender: TObject; var Key: Word;
86          Shift: TShiftState);
87        procedure FormResize(Sender: TObject);
88        procedure lbStatementsClickCheck(Sender: TObject; Index: Integer);
89        procedure lstChange(Sender: TObject; Item: TListItem;
90          Change: TItemChange);
91        procedure FormKeyPress(Sender: TObject; var Key: Char);
92        procedure cboDosageKeyUp(Sender: TObject; var Key: Word;
93          Shift: TShiftState);
94        procedure cboRouteKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
95        procedure cboScheduleKeyUp(Sender: TObject; var Key: Word;
96          Shift: TShiftState);
97    
98      private
99        {selection}
100       FNVAMedCache:   TObjectList;
101       FCacheIEN:   integer;
102       FQuickList:  Integer;
103       FQuickItems: TStringList;
104       FChangePending: Boolean;
105       FKeyTimerActive: Boolean;
106       FActiveMedList: TListView;
107       FRowHeight: Integer;
108       FFromSelf: Boolean;
109       {edit}
110       FAllDoses:  TStringList;
111       FAllDrugs:  TStringList;
112       FGuideline: TStringList;
113       FLastUnits:    string;
114       FLastSchedule: string;
115       FLastDispDrug: string;
116       FLastQuantity: Integer;
117       FLastSupply:   Integer;
118       FLastPickup:   string;
119       FSIGVerb: string;
120       FSIGPrep: string;
121       FDrugID: string;
122       fInptDlg: Boolean;
123       FNonVADlg: Boolean;
124       FUpdated: Boolean;
125       FSuppressMsg: Boolean;
126       FPtInstruct: string;
127       FAltChecked: Boolean;
128       FShrinkDrugMsg: boolean;
129       FQOQuantity: Double;
130       FQODosage: string;
131       FNoZERO: boolean;
132       FIsQuickOrder: boolean;
133       FAdminTimeLbl: string;
134       FDisabledDefaultButton: TButton;
135       FDisabledCancelButton: TButton;
136       FShrinked: boolean;
137       FQOInitial: boolean;
138       FRemoveText : Boolean;
139       FMedName: string;
140       {selection}
141       procedure ChangeDelayed;
142       procedure LoadNonVAMedCache(First, Last: Integer);
143       function FindQuickOrder(const x: string): Integer;
144       function isUniqueQuickOrder(iText: string): Boolean;
145       function GetCacheChunkIndex(idx: integer): integer;
146       procedure ScrollToVisible(AListView: TListView);
147       procedure StartKeyTimer;
148       procedure StopKeyTimer;
149       procedure WMTimer(var Message: TWMTimer); message WM_TIMER;
150       // NON VA MEDS
151       procedure LoadOTCStatements(Dest: TStrings);
152   
153       {edit}
154       procedure ResetOnMedChange;
155       procedure SetOnMedSelect;
156       procedure SetOnQuickOrder;
157       procedure ShowMedSelect;
158       procedure ShowMedFields;
159       procedure ShowControlsSimple;
160       procedure SetDosage(const x: string);
161       procedure SetStatements(x: string);
162       procedure SetStartDate(const x: string);
163       procedure SetSchedule(const x: string);
164       procedure CheckFormAltDose(DispDrug: Integer);
165       function ConstructedDoseFields(const ADose: string; PrependName: Boolean = FALSE): string;
166       function FindCommonDrug(DoseList: TStringList): string;
167       function FindDoseFields(const Drug, ADose: string): string;
168       function OutpatientSig: string;
169       function  SearchStatements(StatementList:TStringList;Statement: string): Boolean;
170       procedure UpdateRelated(DelayUpdate: Boolean = TRUE);
171       procedure UpdateStartExpires(const CurSchedule: string);
172       function DisableDefaultButton(Control: TWinControl): boolean;
173       function DisableCancelButton(Control: TWinControl): boolean;
174       procedure RestoreDefaultButton;
175       procedure RestoreCancelButton;
176       function ValueOf(FieldID: Integer; ARow: Integer = -1): string;
177       function ValueOfResponse(FieldID: Integer; AnInstance: Integer = 1): string;
178       procedure UMDelayClick(var Message: TMessage); message UM_DELAYCLICK;
179   
180     protected
181       procedure InitDialog; override;
182       procedure Validate(var AnErrMsg: string); override;
183     public
184       procedure SetupDialog(OrderAction: Integer; const ID: string); override;
185       procedure CheckDecimal(var AStr: string);
186       property MedName: string read FMedName write FMedName;
187     end;
188   
189   var
190     frmODMedNVA: TfrmODMedNVA;
191     crypto: IXuDigSigS;
192   
193   function OIForNVA(AnIEN: Integer; ForNonVAMed: Boolean; HavePI: boolean = True; PKIActive: Boolean = False): TStrings;
194   procedure CheckAuthForNVAMeds(var x: string);
195   
196   implementation
197   
198   {$R *.DFM}
199   
200   uses rCore, uCore, rODMeds, rODBase, rOrders, fRptBox, fODMedOIFA,
201     fFrame, ORNet, VAUtils;
202   
203   const
204     {grid columns for complex dosing }
205     COL_SELECT   =  0;
206     COL_DOSAGE   =  1;
207     COL_ROUTE    =  2;
208     COL_SCHEDULE =  3;
209     COL_DURATION =  4;
210   
211     COL_SEQUENCE =  5;
212     VAL_DOSAGE   = 10;
213     VAL_ROUTE    = 20;
214     VAL_SCHEDULE = 30;
215     VAL_DURATION = 40;
216     VAL_SEQUENCE = 50;
217     TAB          = #9;
218     {field identifiers}
219     FLD_LOCALDOSE =  1;
220     FLD_STRENGTH  =  2;
221     FLD_DRUG_ID   =  3;
222     FLD_DRUG_NM   =  4;
223     FLD_DOSEFLDS  =  5;
224     FLD_UNITNOUN  =  6;
225     FLD_TOTALDOSE =  7;
226     FLD_DOSETEXT  =  8;
227     FLD_INSTRUCT  = 10;
228     FLD_DOSEUNIT  = 11;
229     FLD_ROUTE_ID  = 15;
230     FLD_ROUTE_NM  = 16;
231     FLD_ROUTE_AB  = 17;
232     FLD_ROUTE_EX  = 18;
233     FLD_SCHEDULE  = 20;
234     FLD_SCHED_EX  = 21;
235     FLD_SCHED_TYP = 22;
236     FLD_DURATION  = 30;
237     FLD_SEQUENCE  = 31;
238     FLD_MISC_FLDS = 50;
239     FLD_SUPPLY    = 51;
240     FLD_QUANTITY  = 52;
241     FLD_REFILLS   = 53;
242     FLD_PICKUP    = 55;
243     FLD_QTYDISP   = 56;
244     FLD_SC        = 58;
245     FLD_PRIOR_ID  = 60;
246     FLD_PRIOR_NM  = 61;
247     FLD_START_ID  = 70;
248     FLD_START_NM  = 71;
249     FLD_EXPIRE    = 72;
250     FLD_ANDTHEN   = 73;
251     FLD_NOW_ID    = 75;
252     FLD_NOW_NM    = 76;
253     FLD_COMMENT   = 80;
254     FLD_PTINSTR   = 85;
255     FLD_START     = 88;
256     FLD_STATEMENTS = 90;
257       {dosage type tab index values}
258     TI_DOSE       =  0;
259     TI_RATE       =  99;
260     TI_COMPLEX    =  1;
261     {misc constants}
262     TIMER_ID = 6902;                                // arbitrary number
263     TIMER_DELAY = 500;                              // 500 millisecond delay
264     TIMER_FROM_DAYS = 1;
265     TIMER_FROM_QTY  = 2;
266   
267     MED_CACHE_CHUNK_SIZE = 100;  
268     {text constants}
269     TX_ADMIN      = 'Requested Start: ';
270     TX_TAKE       = '';
271     TX_NO_DEA     = 'Provider must have a DEA# or VA# to order this medication';
272     TC_NO_DEA     = 'DEA# Required';
273     TX_NO_MED     = 'Medication must be selected.';
274     TX_NO_DOSE    = 'Dosage must be entered.';
275     TX_DOSE_NUM   = 'Dosage may not be numeric only';
276     TX_DOSE_LEN   = 'Dosage may not exceed 60 characters';
277     TX_NO_ROUTE   = 'Route must be entered.';
278     TX_NF_ROUTE   = 'Route not found in the Medication Routes file.';
279     TX_NO_SCHED   = 'Schedule must be entered.';
280     TX_NO_PICK    = 'A method for picking up the medication must be entered.';
281     TX_RNG_REFILL = 'The number of refills must be in the range of 0 through ';
282     TX_SCH_QUOTE  = 'Schedule must not have quotemarks in it.';
283     TX_SCH_MINUS  = 'Schedule must not have a dash at the beginning.';
284     TX_SCH_SPACE  = 'Schedule must have only one space in it.';
285     TX_SCH_LEN    = 'Schedule must be less than 70 characters.';
286     TX_SCH_PRN    = 'Schedule cannot include PRN - use Comments to enter PRN.';
287     TX_SCH_ZERO   = 'Schedule cannot be Q0';
288     TX_SCH_LSP    = 'Schedule may not have leading spaces.';
289     TX_SCH_NS     = 'Unable to resolve non-standard schedule.';
290     TX_MAX_STOP   = 'The maximum expiration for this order is ';
291     TX_OUTPT_IV   = 'This patient has not been admitted.  Only IV orders may be entered.';
292     TX_QTY_NV     = 'Unable to validate quantity.';
293     TX_QTY_MAIL   = 'Quantity for mailed items must be a whole number.';
294     TX_SUPPLY_LIM = 'Days Supply may not be greater than 90.';
295     TX_SUPPLY_LIM1 = 'Days Supply may not be less than 1.';
296     TX_SUPPLY_NINT= 'Days Supply is an invalid number.';
297     TC_RESTRICT   = 'Ordering Restrictions';
298     TC_GUIDELINE  = 'Restrictions/Guidelines';
299     TX_QTY_PRE    = '>> Quantity Dispensed: ';
300     TX_QTY_POST   = ' <<';
301     TX_STARTDT    = 'Unable to interpret start date.';  //cla 7-17-03
302     TX_FUTUREDT   = 'Dates in the future are not allowed.';  //cla 7-17-03
303     TX_NO_FUTURE_DATES  = 'Dates in the future are not allowed.';
304     TX_BAD_DATE         = 'Dates must be in the format mm/dd/yy or mm/yy';
305     TX_CAP_FUTURE       = 'Invalid date';
306   
307   { procedures inherited from fODBase --------------------------------------------------------- }
308   
309   procedure TfrmODMedNVA.FormCreate(Sender: TObject);
310   const
311     TC_RESTRICT = 'Ordering Restrictions';
312   var
313     ListCount: Integer;
314     Restriction, x: string;
315   begin
316     frmFrame.pnlVisit.Enabled := false;
317     AutoSizeDisabled := True;
318    // ActivateOrderDialog(Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
319     inherited;
320     AllowQuickOrder := True;
321   
322     if User.OrderRole in[OR_CLERK] then   // if user is clerk check restrictions else ok to write NonVA Order.
323       begin
324         CheckAuthForNVAMeds(Restriction);
325         if Length(Restriction) > 0 then
326           begin
327             CheckAuthForNVAMeds(Restriction);
328             if Length(Restriction) > 0 then
329               begin
330                 InfoBox(Restriction, TC_RESTRICT, MB_OK);
331                 Close;
332                 Exit;
333               end;
334           end;
335       end;  // clerk restrictions
336   
337     if DlgFormID = OD_MEDNONVA  then FNonVADlg := TRUE;
338     FillerID := 'PSH';    // CLA 6/3/03
339     FGuideline := TStringList.Create;
340     FAllDoses  := TStringList.Create;
341     FAllDrugs  := TStringList.Create;
342     StatusText('Loading Dialog Definition');
343   
344     Responses.Dialog := 'PSH OERR';  // CLA 6/3/03
345     Responses.SetPromptFormat('INSTR', '@');
346     StatusText('Loading Schedules');
347     LoadSchedules(cboSchedule.Items);               // load the schedules combobox (cached)
348     StatusText('');
349     FSuppressMsg := CtrlInits.DefaultText('DispMsg') = '1';
350     InitDialog;
351   
352      // medication selection
353     FRowHeight := MainFontHeight + 1;
354     x := 'NV RX';  // CLA 6/3/03
355     ListForOrderable(FCacheIEN, ListCount, x);
356     lstAll.Items.Count := ListCount;
357     FNVAMedCache := TObjectList.Create;
358     FQuickItems := TStringList.Create;
359     ListForQuickOrders(FQuickList, ListCount, x);
360    if ListCount > 0 then
361     begin
362       lstQuick.Items.Count := ListCount;
363       SubsetOfQuickOrders(FQuickItems, FQuickList, 0, 0);
364       FActiveMedList := lstQuick;
365     end else
366     begin
367       lstQuick.Items.Count := 1;
368       ListCount := 1;
369       FQuickItems.Add('0^(No quick orders available)');
370       FActiveMedList := lstAll;
371     end;
372   
373     // set the height based on user parameter here
374     with lstQuick do if ListCount < VisibleRowCount
375       then Height := (((Height - 6) div VisibleRowCount) * ListCount) + 6;
376     pnlFields.Height := cmdAccept.Top - 4 - pnlFields.Top;
377     cmdAccept.Left := cmdQuit.Left;
378     cmdaccept.Anchors := cmdQuit.anchors;
379     FNoZero := False;
380     FShrinked := False;
381     // Load OTC Statement/Explanations
382     LoadOTCStatements(lbStatements.Items);
383     FRemoveText := True;
384     FShrinkDrugMsg := False;
385     if ScreenReaderActive then lstQuick.TabStop := True;
386   end;
387   
388   procedure TfrmODMedNVA.FormDestroy(Sender: TObject);
389   begin
390     {selection}
391     FQuickItems.Free;
392     FNVAMedCache.Free;
393     {edit}
394     FGuideline.Free;
395     FAllDoses.Free;
396     FAllDrugs.Free;
397    // TAccessibleStringGrid.UnwrapControl(grdDoses);
398     inherited;
399     frmFrame.pnlVisit.Enabled := true;
400   end;
401   
402   procedure TfrmODMedNVA.InitDialog;
403   { Executed each time dialog is reset after pressing accept.  Clears controls & responses }
404   begin
405     inherited;
406     FLastPickup := ValueOf(FLD_PICKUP);
407     Changing := True;
408     ResetOnMedChange;
409     txtMed.Text := '';
410     txtMed.Tag := 0;
411     lstQuick.Selected := nil;
412     lstAll.Selected := nil;
413     if Visible then ShowMedSelect;
414     Changing := False;
415     FIsQuickOrder := False;
416     FQOQuantity := 0 ;
417     FQODosage   := '';
418     memComment.Clear;  // sometimes the sig is in the comment
419     LoadOTCStatements(lbStatements.Items);
420   
421   end;
422   
423   procedure TfrmODMedNVA.SetupDialog(OrderAction: Integer; const ID: string);
424   var
425     //AnInstr: string;
426     OrderID: string;
427   begin
428     inherited;
429    // if FInptDlg and (not FOutptIV) then DisplayGroup := DisplayGroupByName('UD RX')
430     DisplayGroup := DisplayGroupByName('NV RX');   // CLA 6/3/03
431     if XfInToOutNow then DisplayGroup := DisplayGroupByName('O RX');
432     if CharAt(ID,1)='X' then
433     begin
434       OrderID := Copy(Piece(ID, ';', 1), 2, Length(ID));
435       CheckExistingPI(OrderID, FPtInstruct);
436     end;
437     if OrderAction = ORDER_QUICK then
438       FIsQuickOrder := True
439     else
440       FIsQuickOrder := False;
441   //  if OrderAction in [ORDER_COPY, ORDER_EDIT] then Responses.Remove('START', 1);
442     if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then
443     begin
444       Changing := True;
445       txtMed.Tag  := StrToIntDef(Responses.IValueFor('ORDERABLE', 1), 0);
446       SetOnMedSelect;
447       SetOnQuickOrder;                                  // set up for this medication
448       ShowMedFields;
449       if (OrderAction = ORDER_EDIT) and OrderIsReleased(Responses.EditOrder)
450         then btnSelect.Enabled := False;
451       UpdateRelated(FALSE);
452       Changing := False;
453     end;
454     { prevent the SIG from being part of the comments on pre-CPRS prescriptions }
455     {if (OrderAction in [ORDER_COPY, ORDER_EDIT]) and (cboDosage.Text = '') then  //commented out by cla 2/27/04 - CQ 2591
456     begin
457       OrderID := Copy(Piece(ID, ';', 1), 2, Length(ID));
458       AnInstr := TextForOrder(OrderID);
459       pnlMessage.TabOrder := 0;
460       OrderMessage(AnInstr);
461       if OrderAction = ORDER_COPY
462         then AnInstr := 'Copy: ' + AnInstr
463         else AnInstr := 'Change: ' + AnInstr;
464       Caption := AnInstr;
465       memComment.Clear;  // sometimes the sig is in the comment
466       lbStatements.Clear;
467     end;}
468     ControlChange(Self);
469   end;
470   
471   procedure TfrmODMedNVA.Validate(var AnErrMsg: string);
472   var
473     i: Integer;
474     StartDate: TFMDateTime;
475   
476     procedure SetError(const x: string);
477     begin
478       if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
479       AnErrMsg := AnErrMsg + x;
480     end;
481   
482     procedure ValidateDosage(const x: string);
483     begin
484       if Length(x) = 0 then SetError(TX_NO_DOSE);
485     end;
486   
487     procedure ValidateRoute(const x: string; NeedLookup: Boolean; AnInstance: Integer);
488     var
489       RouteID, RouteAbbr: string;
490     begin
491       if (Length(x) = 0) and (not MedIsSupply(txtMed.Tag)) then SetError(TX_NO_ROUTE);
492       if (Length(x) > 0) and NeedLookup then
493       begin
494         LookupRoute(x, RouteID, RouteAbbr);
495         if RouteID = '0'
496           then SetError(TX_NF_ROUTE)
497           else Responses.Update('ROUTE', AnInstance, RouteID, RouteAbbr);
498       end;
499     end;
500   
501     procedure ValidateSchedule(const x: string; AnInstance: Integer);
502     const
503       SCH_BAD = 0;
504       SCH_NO_RTN = -1;
505     var
506       ValidLevel: Integer;
507       ARoute, ADrug: string;
508     begin
509       ARoute := ValueOfResponse(FLD_ROUTE_ID, AnInstance);
510       ADrug  := ValueOfResponse(FLD_DRUG_ID,  AnInstance);
511    {  if (Length(x) = 0) and (not FNonVADlg) then SetError(TX_NO_SCHED)
512       else if (Length(x) = 0) and FNonVADlg and ScheduleRequired(txtMed.Tag, ARoute, ADrug)
513       then SetError(TX_NO_SCHED);
514   }
515       if Length(x) > 0 then
516       begin
517         ValidLevel := ValidSchedule(x, 'O');
518         if ValidLevel = SCH_NO_RTN then
519         begin
520           if Pos('"', x) > 0                              then SetError(TX_SCH_QUOTE);
521           if Copy(x, 1, 1) = '-'                          then SetError(TX_SCH_MINUS);
522           if Pos(' ', Copy(x, Pos(' ', x) + 1, 999)) > 0  then SetError(TX_SCH_SPACE);
523           if Length(x) > 70                               then SetError(TX_SCH_LEN);
524           if (Pos('P RN', x) > 0) or (Pos('PR N', x) > 0) then SetError(TX_SCH_PRN);
525           if Pos('Q0', x) > 0                             then SetError(TX_SCH_ZERO);
526           if TrimLeft(x) <> x                             then SetError(TX_SCH_LSP);
527         end;
528         if ValidLevel = SCH_BAD then SetError(TX_SCH_NS);
529       end;
530     end;
531   
532   begin
533     inherited;
534      begin
535     AnErrMsg := '';
536     if User.NoOrdering then AnErrMsg := 'Ordering has been disabled. Press Quit';
537   
538     ControlChange(Self);                            // make sure everything is updated
539     if txtMed.Tag = 0 then SetError(TX_NO_MED);
540     if Responses.InstanceCount('INSTR') < 1 then SetError(TX_NO_DOSE);
541     i := Responses.NextInstance('INSTR', 0);
542     while i > 0 do
543     begin
544    {   if (ValueOfResponse(FLD_DRUG_ID, i) = '') then
545        begin
546         if not ContainsAlpha(Responses.IValueFor('INSTR', i)) then SetError(TX_DOSE_NUM);
547         if Length(Responses.IValueFor('INSTR', i)) > 60       then SetError(TX_DOSE_LEN);
548        end;
549       ValidateRoute(Responses.EValueFor('ROUTE', i), Responses.IValueFor('ROUTE', i) = '', i);
550       ValidateSchedule(ValueOfResponse(FLD_SCHEDULE, i), i);
551    }
552       i := Responses.NextInstance('INSTR', i);
553     //  inherited;  -  do not reject past dates - historical would not be allowed
554   
555          if calStart.Text <> '' then
556        begin
557           StartDate := ValidDateTimeStr(calStart.Text,'TS');
558           if StartDate > FMNow then SetError(TX_NO_FUTURE_DATES);
559           if StartDate < 0 then SetError(TX_BAD_DATE);
560        end;
561      end;
562     end;
563     if Pos(U, self.memComment.Text) > 0 then SetError('Comments cannot contain a "^".');
564   end;
565   
566   { Navigate medication selection lists ------------------------------------------------------- }
567   
568   { txtMed methods (including timers) }
569   
570   procedure TfrmODMedNVA.WMTimer(var Message: TWMTimer);
571   begin
572     inherited;
573     if (Message.TimerID = TIMER_ID) then
574     begin
575       StopKeyTimer;
576       ChangeDelayed;
577     end;
578   end;
579   
580   procedure TfrmODMedNVA.StartKeyTimer;
581   { start (or restart) a timer (done on keyup to delay before calling OnKeyPause) }
582   var
583     ATimerID: Integer;
584   begin
585     StopKeyTimer;
586     ATimerID := SetTimer(Handle, TIMER_ID, TIMER_DELAY, nil);
587     FKeyTimerActive := ATimerID > 0;
588     // if can't get a timer, just call the event immediately  F
589     if not FKeyTimerActive then Perform(WM_TIMER, TIMER_ID, 0);
590   end;
591   
592   procedure TfrmODMedNVA.StopKeyTimer;
593   { stop the timer (done whenever a key is pressed or the combobox no longer has focus) }
594   begin
595     if FKeyTimerActive then
596     begin
597       KillTimer(Handle, TIMER_ID);
598       FKeyTimerActive := False;
599     end;
600   end;
601   
602   procedure TfrmODMedNVA.txtMedKeyDown(Sender: TObject; var Key: Word;
603     Shift: TShiftState);
604   var
605     i: Integer;
606     x: string;
607   begin
608     if Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN] then             // navigation
609     begin
610       FActiveMedList.Perform(WM_KEYDOWN, Key, 0);
611       FFromSelf := True;
612       txtMed.Text := FActiveMedList.Selected.Caption;
613       txtMed.SelectAll;
614       FFromSelf := False;
615       Key := 0;
616     end
617     else if Key = VK_BACK then
618     begin
619       FFromSelf := True;
620       x := txtMed.Text;
621       i := txtMed.SelStart;
622       if i > 1 then Delete(x, i + 1, Length(x)) else x := '';
623       txtMed.Text := x;
624       if i > 1 then txtMed.SelStart := i;
625       FFromSelf := False;
626     end
627     else {StartKeyTimer};
628   end;
629   
630   procedure TfrmODMedNVA.txtMedKeyUp(Sender: TObject; var Key: Word;
631     Shift: TShiftState);
632   begin
633     if not (Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN]) then StartKeyTimer;
634   end;
635   
636   procedure TfrmODMedNVA.txtMedChange(Sender: TObject);
637   begin
638     if FFromSelf then Exit;
639     FChangePending := True;
640   end;
641   
642   procedure TfrmODMedNVA.ScrollToVisible(AListView: TListView);
643   var
644     Offset: Integer;
645     SelRect: TRect;
646   begin
647     AListView.Selected.MakeVisible(FALSE);
648     SelRect := AListView.Selected.DisplayRect(drBounds);   //  CQ: 6636
649     FRowHeight := SelRect.Bottom - SelRect.Top;
650     Offset := AListView.Selected.Index - AListView.TopItem.Index;
651     Application.ProcessMessages;
652     if Offset > 0 then AListView.Scroll(0, (Offset * FRowHeight));
653     Application.ProcessMessages;
654   end;
655   
656   procedure TfrmODMedNVA.ChangeDelayed;
657   var
658     QuickIndex, AllIndex: Integer;
659     NewText, OldText, UserText: string;
660     UniqueText: Boolean;
661   begin
662     FRemoveText := False;
663     UniqueText := False;
664     FChangePending := False;
665     if (Length(txtMed.Text) > 0) and (txtMed.SelStart = 0) then Exit;  // don't lookup null
666     // lookup item in appropriate list box
667     NewText := '';
668     UserText := Copy(txtMed.Text, 1, txtMed.SelStart);
669     QuickIndex := FindQuickOrder(UserText);
670     AllIndex := IndexOfOrderable(FCacheIEN, UserText);  // but always synch the full list
671     if UserText <> Copy(txtMed.Text, 1, txtMed.SelStart) then Exit;  // if typing during lookup
672     if AllIndex > -1 then
673     begin
674       lstAll.Selected := lstAll.Items[AllIndex];
675       FActiveMedList := lstAll;
676     end;
677     if QuickIndex > -1 then
678     begin
679       try
680         lstQuick.Selected := lstQuick.Items[QuickIndex];
681         lstQuick.ItemFocused := lstQuick.Selected;
682         NewText := lstQuick.Selected.Caption;
683         FActiveMedList := lstQuick;
684         //Search Quick List for Uniqueness
685         UniqueText := isUniqueQuickOrder(UserText);
686       except
687         //doing nothing  short term solution related to 117
688       end;
689     end
690     else if AllIndex > -1 then
691     begin
692       lstAll.Selected := lstAll.Items[AllIndex];
693       lstAll.ItemFocused := lstAll.Selected;
694       NewText := lstAll.Selected.Caption;
695       lstQuick.Selected := nil;
696       FActiveMedList := lstAll;
697       //List is alphabetical, So compare next Item in list to establish uniqueness.
698       if CompareText(UserText, Copy(lstAll.Items[AllIndex+1].Caption, 1, Length(UserText))) <> 0 then
699         UniqueText := True;
700     end
701     else
702     begin
703       lstQuick.Selected := nil;
704       lstAll.Selected := nil;
705       FActiveMedList := lstAll;
706       NewText := txtMed.Text;
707     end;
708     if (AllIndex > -1) and (QuickIndex > -1) then  //Not Unique Between Lists
709       UniqueText := False;
710     FFromSelf := True;
711     if UniqueText then
712     begin
713       OldText := Copy(txtMed.Text, 1, txtMed.SelStart);
714       txtMed.Text := NewText;
715       //txtMed.SelStart := Length(OldText);  // v24.14 RV
716       txtMed.SelStart := Length(UserText);   // v24.14 RV
717       txtMed.SelLength := Length(NewText);
718     end
719     else begin
720       txtMed.Text := UserText;
721       txtMed.SelStart := Length(txtMed.Text);
722     end;
723     FFromSelf := False;
724     if lstAll.Selected <> nil then
725       ScrollToVisible(lstAll);
726     if lstQuick.Selected <> nil then
727       ScrollToVisible(lstQuick);
728     if Not UniqueText then
729     begin
730       lstQuick.ItemIndex := -1;
731       lstAll.ItemIndex := -1;
732     end;
733     FRemoveText := True;
734   end;
735   
736   procedure TfrmODMedNVA.txtMedExit(Sender: TObject);
737   begin
738     StopKeyTimer;
739     if not ((ActiveControl = lstAll) or (ActiveControl = lstQuick)) then ChangeDelayed;
740   end;
741   
742   { lstAll & lstQuick methods }
743   
744   procedure TfrmODMedNVA.ListViewEnter(Sender: TObject);
745   begin
746     inherited;
747     FActiveMedList := TListView(Sender);
748     with Sender as TListView do
749     begin
750       if Selected = nil then Selected := TopItem;
751       if Name = 'lstQuick' then lstAll.Selected := nil else lstQuick.Selected := nil;
752       ItemFocused := Selected;
753     end;
754   end;
755   
756   procedure TfrmODMedNVA.ListViewClick(Sender: TObject);
757   begin
758     inherited;
759     btnSelect.Visible := True;
760     btnSelect.Enabled := True;
761     //txtMed.Text := FActiveMedList.Selected.Caption;
762     PostMessage(Handle, UM_DELAYCLICK, 0, 0);
763   end;
764   
765   procedure TfrmODMedNVA.UMDelayClick(var Message: TMessage);
766   begin
767     btnSelectClick(Self);
768   end;
769   
770   procedure TfrmODMedNVA.ListViewEditing(Sender: TObject; Item: TListItem;
771     var AllowEdit: Boolean);
772   begin
773     AllowEdit := FALSE;
774   end;
775   
776   procedure TfrmODMedNVA.ListViewResize(Sender: TObject);
777   begin
778     with Sender as TListView do Columns.Items[0].Width := ClientWidth - 20;
779   end;
780   
781   { lstAll Methods (lstAll is TListView) }
782   
783   // Cache is a list of 100 string lists, starting at idx 0
784   procedure TfrmODMedNVA.LoadNonVAMedCache(First, Last: Integer);
785   var
786     firstChunk, lastchunk, i: integer;
787     list: TStringList;
788     firstMed, LastMed: integer;
789   
790   begin
791     firstChunk := GetCacheChunkIndex(First);
792     lastChunk := GetCacheChunkIndex(Last);
793     for i := firstChunk to lastChunk do
794     begin
795       if (FNVAMedCache.Count <= i) or (not assigned(FNVAMedCache[i])) then
796       begin
797         while FNVAMedCache.Count <= i do
798           FNVAMedCache.add(nil);
799         list := TStringList.Create;
800         FNVAMedCache[i] := list;
801         firstMed := i * MED_CACHE_CHUNK_SIZE;
802         LastMed := firstMed + MED_CACHE_CHUNK_SIZE - 1;
803         if LastMed >= lstAll.Items.Count then
804           LastMed := lstAll.Items.Count - 1;
805         SubsetOfOrderable(list, false, FCacheIEN, firstMed, lastMed);
806       end;
807     end;
808   end;
809   
810   procedure TfrmODMedNVA.lstAllData(Sender: TObject; Item: TListItem);
811   var
812     x: string;
813     chunk: integer;
814     list: TStringList;
815   begin
816     LoadNonVAMedCache(Item.Index, Item.Index);
817     chunk := GetCacheChunkIndex(Item.Index);
818     list := TStringList(FNVAMedCache[chunk]);
819     //This is to make sure that the index that is being used is not outside of the stringlist
820     If Item.Index mod MED_CACHE_CHUNK_SIZE < list.Count then begin
821      x := list[Item.Index mod MED_CACHE_CHUNK_SIZE];
822      Item.Caption := Piece(x, U, 2);
823      Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0));
824     end;
825   end;
826   
827   procedure TfrmODMedNVA.lstAllDataHint(Sender: TObject; StartIndex,
828     EndIndex: Integer);
829   begin
830     LoadNonVAMedCache(StartIndex, EndIndex);
831   end;
832   
833   { Medication is now selected ---------------------------------------------------------------- }
834   
835   procedure TfrmODMedNVA.btnSelectClick(Sender: TObject);
836   var
837     MedIEN: Integer;
838     //MedName: string;
839     QOQuantityStr: string;
840     ErrMsg, temp: string;
841   begin
842     inherited;
843     QOQuantityStr := '';
844     btnSelect.SetFocus;
845     self.MedName := '';                             // let the exit events finish
846     if pnlMeds.Visible then                         // display the medication fields
847     begin
848       Changing := True;
849       ResetOnMedChange;
850       if (FActiveMedList = lstQuick) and (lstQuick.Selected <> nil) then   // quick order
851       begin
852         ErrMsg := '';
853         FIsQuickOrder := True;
854         FQOInitial := True;
855         Responses.QuickOrder := Integer(lstQuick.Selected.Data);
856         txtMed.Tag  := StrToIntDef(Responses.IValueFor('ORDERABLE', 1), 0);
857         IsActivateOI(ErrMsg, txtMed.Tag);
858         if Length(ErrMsg)>0 then
859         begin
860           //btnSelect.Visible := False;
861           btnSelect.Enabled := False;
862           ShowMsg(ErrMsg);
863           Exit;
864         end;
865         if txtMed.Tag = 0 then
866         begin
867           //btnSelect.Visible := False;
868           btnSelect.Enabled := False;
869           txtMed.SetFocus;
870           Exit;
871         end;
872         SetOnMedSelect;   // set up for this medication
873         SetOnQuickOrder;  // insert quick order responses
874         ShowMedFields;
875       end
876       else if (FActiveMedList = lstAll) and (lstAll.Selected <> nil) then  // orderable item
877       begin
878         MedIEN := Integer(lstAll.Selected.Data);
879         self.MedName := lstAll.Selected.Caption;
880         txtMed.Tag := MedIEN;
881         ErrMsg := '';
882         IsActivateOI(ErrMsg, txtMed.Tag);
883         if Length(ErrMsg)>0 then
884         begin
885           btnSelect.Enabled := False;
886           ShowMsg(ErrMsg);
887           Exit;
888         end;
889   
890        { if Pos(' NF', MedName) > 0 then
891         begin
892           CheckFormularyOI(MedIEN, MedName, FNonVADlg);
893           FAltChecked := True;
894         end;
895        }
896         if MedIEN <> txtMed.Tag then
897         begin
898           txtMed.Tag := MedIEN;
899           temp := self.MedName;
900           self.MedName := txtMed.Text;
901           txtMed.Text := Temp;
902         end;
903         SetOnMedSelect;
904         ShowMedFields;
905       end
906       else                                           // no selection
907       begin
908         MessageBeep(0);
909         Exit;
910       end;
911       UpdateRelated(False);
912       Changing := False;
913       ControlChange(Self);
914     end
915     else ShowMedSelect;                             // show the selection fields
916     FNoZERO   := False;
917   end;
918   
919   procedure TfrmODMedNVA.ResetOnMedChange;
920   begin
921     cboDosage.Items.Clear;
922     chkPRN.Checked := False;
923     cboSchedule.ItemIndex := -1;
924     cboSchedule.Text := '';  // leave items intact
925     memComment.Lines.Clear;
926     cboDosage.Text := '';
927     cboRoute.Items.Clear;
928     cboRoute.Text := '';
929     cboRoute.Hint := cboRoute.Text;
930     ResetControl(cboSchedule);        /// cla 2/26/04
931     Responses.Clear;
932   end;
933   
934   procedure TfrmODMedNVA.SetOnMedSelect;
935   var
936     i,j: Integer;
937     temp,x: string;
938     QOPiUnChk: boolean;
939     PKIEnviron: boolean;
940   begin
941     // clear controls?
942     cboDosage.Tag := -1;
943     QOPiUnChk := False;
944     PKIEnviron := False;
945     if GetPKISite then PKIEnviron := True;
946     with CtrlInits do
947     begin
948       // set up CtrlInits for orderable item
949       LoadOrderItem(OIForNVA(txtMed.Tag, FNonVADlg, IncludeOIPI, PKIEnviron));
950       // set up lists & initial values based on orderable item
951       SetControl(txtMed,       'Medication');
952       if (self.MedName <> '') then
953          begin
954            if (txtMed.Text <> self.MedName) then
955              begin
956                temp := self.MedName;
957                self.MedName := txtMed.Text;
958                txtMed.Text := temp;
959              end
960            else MedName := '';
961          end;
962       SetControl(cboDosage,    'Dosage');
963       SetControl(cboRoute,     'Route');
964       SetControl(calStart,     'START');   //cla 7-17-03
965       if cboRoute.Items.Count = 1 then cboRoute.ItemIndex := 0;
966       cboRouteChange(Self);
967       x := DefaultText('Schedule');
968       if x <> '' then
969       begin
970         cboSchedule.SelectByID(x);
971         cboSchedule.Text := x;
972       end;
973       if Length(ValueOf(FLD_QTYDISP))>10 then
974       begin
975       end;
976       FAllDoses.Text := TextOf('AllDoses');
977       FAllDrugs.Text := TextOf('Dispense');
978       FGuideline.Text := TextOf('Guideline');
979       case FGuideline.Count of
980       0: lblGuideline.Visible := False;
981       1:   begin
982              lblGuideline.Caption := FGuideline[0];
983              lblGuideline.Visible := TRUE;
984            end;
985       else begin
986              lblGuideline.Caption := 'Display Restrictions/Guidelines';
987              lblGuideline.Visible := TRUE;
988            end;
989       end;
990   
991         DEASig := '';
992         if GetPKISite then DEASig := DefaultText('DEASchedule');
993         FSIGVerb := DefaultText('Verb');
994         if Length(FSIGVerb) = 0 then FSIGVerb := TX_TAKE;
995         FSIGPrep := DefaultText('Preposition');
996         for j := 0 to Responses.TheList.Count - 1 do
997         begin
998           if (TResponse(Responses.theList[j]).PromptID = 'PI') and (TResponse(Responses.theList[j]).EValue = ' ') then
999             QOPiUnChk := True;
1000        end;
1001        FPtInstruct := TextOf('PtInstr');
1002        for i := 1 to Length(FPtInstruct) do if Ord(FPtInstruct[i]) < 32 then FPtInstruct[i] := ' ';
1003        FPtInstruct := TrimRight(FPtInstruct);
1004        if Length(FPtInstruct) > 0 then
1005        begin
1006          if FShrinked then
1007          begin
1008             FShrinked := False;
1009          end;
1010          if QOPiUnChk then
1011         end else
1012        begin
1013          if not FShrinked then
1014          begin
1015             FShrinked := True;
1016          end;
1017        end;
1018   //   end;
1019      pnlMessage.TabOrder := cboDosage.TabOrder + 1;
1020  
1021   //   DispOrderMessage(TextOf('Message'));
1022    end;
1023  end;
1024  
1025  procedure TfrmODMedNVA.SetOnQuickOrder;
1026  var
1027    AResponse: TResponse;
1028    x,LocRoute,TempSch,DispGrp: string;
1029    i, DispDrug: Integer;
1030  begin
1031    // txtMed already set by SetOnMedSelect
1032    with Responses do
1033    begin
1034      if (InstanceCount('INSTR') > 1) or (InstanceCount('DAYS') > 0) then // complex dose
1035      begin
1036        i := Responses.NextInstance('INSTR', 0);
1037        while i > 0 do
1038        begin
1039          SetDosage(IValueFor('INSTR', i));
1040          with cboDosage do
1041            if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] else x := Text;
1042  
1043          SetControl(cboRoute,  'ROUTE', i);
1044          with cboRoute do
1045            if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] else x := Text;
1046          if FIsQuickOrder then TempSch := cboSchedule.Text;
1047          SetSchedule(IValueFor('SCHEDULE', i));
1048          if (cboSchedule.Text = '') and FIsQuickOrder then
1049          begin
1050            cboSchedule.SelectByID(TempSch);
1051            cboSchedule.Text := TempSch;
1052          end;
1053          x := cboSchedule.Text;
1054          if chkPRN.Checked then x := x + ' PRN';
1055          with cboSchedule do
1056            if ItemIndex > -1 then x := x + TAB + Items[ItemIndex];
1057          if      IValueFor('CONJ', i) = 'A' then x := 'AND'
1058          else if IValueFor('CONJ', i) = 'T' then x := 'THEN'
1059          else if IValueFor('CONJ', i) = 'X' then x := 'EXCEPT'
1060          else x := '';
1061          i := Responses.NextInstance('INSTR', i);
1062        end; {while}
1063      end else                                      // single dose
1064      begin
1065        if FIsQuickOrder then
1066        begin
1067          FQODosage := IValueFor('INSTR', 1);
1068          SetDosage(FQODosage);
1069          TempSch := cboSchedule.Text;
1070        end
1071        else
1072          SetDosage(IValueFor('INSTR', 1));
1073        SetControl(cboDosage, 'DOSAGE', 1); // CQ: HDS00007776
1074        SetControl(cboRoute,  'ROUTE',     1);  //AGP ADDED ROUTE FOR CQ 11252
1075        SetSchedule(IValueFor('SCHEDULE',  1));
1076        if (cboSchedule.Text = '') and FIsQuickOrder then
1077        begin
1078          cboSchedule.SelectByID(TempSch);
1079          cboSchedule.Text := TempSch;
1080        end;
1081        DispDrug := StrToIntDef(ValueOf(FLD_DRUG_ID), 0);
1082        if DispDrug > 0 then x := QuantityMessage(DispDrug) else x := '';
1083      SetControl(memComment ,  'COMMENT',  1);
1084      SetControl(calStart, 'START', 1);
1085      SetStartDate(EValueFor('START', 1));
1086      SetStatements(EValueFor('STATEMENTS', 1));
1087      if FIsQuickOrder then
1088        begin
1089          if not QOHasRouteDefined(Responses.QuickOrder) then
1090          begin
1091            LocRoute := GetPickupForLocation(IntToStr(Encounter.Location));
1092          end;
1093        end;
1094        AResponse := Responses.FindResponseByName('SC',     1);
1095        DispGrp := NameOfDGroup(Responses.DisplayGroup);
1096       if (AResponse = nil) or ((StrToIntDef(Piece(Responses.CopyOrder,';',1),0)>0) and AnsiSameText('Out. Meds',DispGrp)) then
1097        begin
1098          LocRoute := GetPickupForLocation(IntToStr(Encounter.Location));
1099        end;
1100  
1101      end;
1102    end; {with}
1103    if FInptDlg then
1104    begin
1105      x := ValueOfResponse(FLD_SCHEDULE, 1);
1106      if Length(x) > 0 then UpdateStartExpires(x);
1107    end;
1108  end;
1109  
1110  
1111  procedure TfrmODMedNVA.ShowMedSelect;
1112  begin
1113    txtMed.SelStart := Length(txtMed.Text);
1114    ChangeDelayed;  // synch the listboxes with display
1115    pnlFields.Enabled := False;
1116    pnlFields.Visible := False;
1117    pnlMeds.Enabled   := True;
1118    pnlMeds.Visible   := True;
1119    btnSelect.Caption := 'OK';
1120    btnSelect.Top     := cmdAccept.Top;
1121    btnSelect.Anchors := [akRight, akBottom];
1122    btnSelect.BringToFront;
1123    cmdAccept.Visible := False;
1124    cmdAccept.Default := False;
1125    btnSelect.Default := True;
1126    btnSelect.TabOrder := cmdAccept.TabOrder;
1127    cmdAccept.TabStop := False;
1128    txtMed.Font.Color := clWindowText;
1129    txtMed.Color      := clWindow;
1130    txtMed.ReadOnly   := False;
1131    txtMed.SelectAll;
1132    txtMed.SetFocus;
1133    FDrugID := '';
1134  end;
1135  
1136  procedure TfrmODMedNVA.ShowMedFields;
1137  begin
1138     pnlMeds.Enabled   := False;
1139    pnlMeds.Visible   := False;
1140    pnlFields.Enabled := True;
1141    pnlFields.Visible := True;
1142    btnSelect.Caption := 'Change';
1143    btnSelect.Top     := txtMed.Top;
1144    btnSelect.Anchors := [akRight, akTop];
1145    btnSelect.Default := False;
1146    cmdAccept.Visible := True;
1147    cmdAccept.Default := False;
1148    btnSelect.TabOrder := txtMed.TabOrder + 1;
1149    cmdAccept.TabStop := True;
1150    txtMed.Width      := memOrder.Width;
1151    txtMed.Font.Color := clInfoText;
1152    txtMed.Color      := clInfoBk;
1153    txtMed.ReadOnly   := True;
1154    ShowControlsSimple;
1155  end;
1156  
1157  procedure TfrmODMedNVA.ShowControlsSimple;
1158  begin
1159    tabDose.TabIndex := TI_DOSE;
1160    cboDosage.Visible := True;
1161    lblRoute.Visible := True;
1162    cboRoute.Visible := True;
1163    lblSchedule.Visible := True;
1164    cboSchedule.Visible := True;
1165    chkPRN.Visible := True;
1166    ActiveControl := cboDosage;
1167  end;
1168  
1169  procedure TfrmODMedNVA.SetDosage(const x: string);
1170  var
1171    i, DoseIndex: Integer;
1172  begin
1173    DoseIndex := -1;
1174    with cboDosage do
1175    begin
1176      ItemIndex := -1;
1177      for i := 0 to Pred(Items.Count) do
1178        if UpperCase(Piece(Items[i], U, 5)) = UpperCase(x) then
1179        begin
1180          DoseIndex := i;
1181          Break;
1182        end;
1183      if DoseIndex < 0 then Text := x else ItemIndex := DoseIndex;
1184    end;
1185  end;
1186  
1187  procedure TfrmODMedNVA.SetStatements(x: string);
1188  var
1189  i,stmtLen: integer;
1190  stmt: string;
1191  hldStr, matchStmt: string;
1192  stmtList: TStringList;
1193  begin
1194     stmt := x;
1195     stmtLen := Length(stmt);
1196     stmtList := TStringList.Create;
1197     stmtList.Clear;
1198     for i := 1 to stmtLen do
1199     if((stmt[i] <> NVA_CR) and (stmt[i] <> NVA_LF)) then
1200        hldStr := hldStr + stmt[i]
1201     else
1202        hldStr := hldStr + '^';
1203     hldStr := hldStr + '^';  //  end line with a '^' for piece.
1204  
1205     //  Load List of statements.
1206     stmtList.Add(Piece(hldStr,U,1));
1207     stmtList.Add(Piece(hldStr,U,3));
1208     stmtList.Add(Piece(hldStr,U,5));
1209     stmtList.Add(Piece(hldStr,U,7));
1210  
1211     for i := 0 to lbStatements.count-1 do
1212     begin
1213        matchStmt := lbStatements.Items.Strings[i];
1214        if SearchStatements(stmtList,matchStmt) then
1215           lbStatements.Checked[i] := True;
1216     end;
1217  
1218  end;
1219  
1220  function TfrmODMedNVA.SearchStatements(StatementList: TStringList; Statement: string): Boolean;
1221  var
1222  i : integer;
1223  x: string;
1224  begin
1225  
1226      Result := FALSE;
1227      for i := 0 to StatementList.Count-1 do
1228      begin
1229         x := StatementList.Strings[i];
1230         if Statement = Trim(StatementList.Strings[i]) then
1231         begin
1232             Result := TRUE;
1233             Break;
1234         end;
1235      end;
1236  end;
1237  
1238  procedure TfrmODMedNVA.SetStartDate(const x: string);
1239  begin
1240       calStart.Text := x;
1241  end;
1242  
1243  procedure TfrmODMedNVA.SetSchedule(const x: string);
1244  var
1245    NonPRNPart: string;
1246  begin
1247   
1248    cboSchedule.ItemIndex := -1;
1249    if Pos('PRN', x) > 0 then
1250    begin
1251      NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
1252      cboSchedule.SelectByID(NonPRNPart);
1253      if cboSchedule.ItemIndex < 0 then
1254      begin
1255        if NSSchedule then
1256        begin
1257          chkPRN.Checked := False;
1258          cboSchedule.Text := '';
1259        end else
1260        begin
1261          chkPRN.Checked := True;
1262          cboSchedule.Items.Add(NonPRNPart);
1263          cboSchedule.Text := NonPRNPart;
1264        end;
1265      end else
1266        chkPRN.Checked := True;
1267    end else
1268    begin
1269      chkPRN.Checked := False;
1270      cboSchedule.SelectByID(x);
1271      if cboSchedule.ItemIndex < 0 then
1272      begin
1273        if NSSchedule then
1274        begin
1275          cboSchedule.Text := '';
1276        end
1277        else
1278        begin
1279          cboSchedule.Items.Add(x);
1280          cboSchedule.Text := x;
1281          cboSchedule.SelectByID(x);
1282        end;
1283      end;
1284    end;
1285  end;
1286  
1287  { Medication edit --------------------------------------------------------------------------- }
1288  
1289  procedure TfrmODMedNVA.tabDoseChange(Sender: TObject);
1290  begin
1291    inherited;
1292    case tabDose.TabIndex of
1293    TI_DOSE:    begin
1294                  // clean up responses?
1295                  ShowControlsSimple;
1296                  ControlChange(Self);
1297                end;
1298    TI_RATE:    begin
1299                  // for future use...
1300                end;
1301     end; {case}
1302  end;
1303  
1304  procedure TfrmODMedNVA.lblGuidelineClick(Sender: TObject);
1305  var
1306    TextStrings: TStringList;
1307  begin
1308    inherited;
1309    TextStrings := TStringList.Create;
1310    try
1311      TextStrings.Text := FGuideline.Text;
1312      ReportBox(TextStrings, TC_GUIDELINE, TRUE);
1313    finally
1314      TextStrings.Free;
1315    end;
1316  end;
1317  
1318  { cboDosage ------------------------------------- }
1319  
1320  procedure TfrmODMedNVA.CheckFormAltDose(DispDrug: Integer);
1321  var
1322    OI: Integer;
1323    OIName: string;
1324  begin
1325    if FAltChecked or (DispDrug = 0) then Exit;
1326    OI := txtMed.Tag;
1327    OIName := txtMed.Text;
1328    CheckFormularyDose(DispDrug, OI, OIName, FNonVADlg);
1329    if OI <> txtMed.Tag then
1330    begin
1331      ResetOnMedChange;
1332      txtMed.Tag  := OI;
1333      txtMed.Text := OIName;
1334      SetOnMedSelect;
1335    end;
1336  end;
1337  
1338  procedure TfrmODMedNVA.cboDosageClick(Sender: TObject);
1339  var
1340    DispDrug: Integer;
1341  begin
1342    inherited;
1343  UpdateRelated(False);
1344    DispDrug := StrToIntDef(ValueOf(FLD_DRUG_ID), 0);
1345    if cboDosage.Text = '' then    //cla 3/18/04
1346    begin
1347      DispDrug := 0;
1348      cboDosage.ItemIndex := -1;
1349    end;
1350    {  hds8084
1351    if DispDrug > 0 then
1352    begin
1353      if not FSuppressMsg then begin
1354        pnlMessage.TabOrder := cboDosage.TabOrder + 1;
1355        DispOrderMessage(DispenseMessage(DispDrug));
1356      end;
1357      x := QuantityMessage(DispDrug);
1358    end
1359    else x := '';
1360    }
1361    with cboDosage do
1362      if (ItemIndex > -1) and (Piece(Items[ItemIndex], U, 3) = 'NF')
1363        then CheckFormAltDose(DispDrug);
1364  end;
1365  
1366  procedure TfrmODMedNVA.cboDosageChange(Sender: TObject);
1367  begin
1368    inherited;
1369    UpdateRelated;
1370  end;
1371  
1372  procedure TfrmODMedNVA.cboDosageExit(Sender: TObject);
1373  begin
1374    inherited;
1375    if ActiveControl = memMessage then
1376    begin
1377      memMessage.SendToBack;
1378      PnlMessage.Visible := False;
1379      Exit;
1380    end;
1381    if ActiveControl = memComment then
1382    begin
1383     if PnlMessage.Visible = true then
1384     begin
1385       memMessage.SendToBack;
1386       PnlMessage.Visible := False;
1387     end;
1388    end
1389    else if (ActiveControl <> btnSelect) and (ActiveControl <> memComment) then
1390    begin
1391     if PnlMessage.Visible = true then
1392     begin
1393       memMessage.SendToBack;
1394       PnlMessage.Visible := False;
1395     end;
1396     cboDosageClick(Self);
1397    end;
1398  end;
1399  
1400  procedure TfrmODMedNVA.cboDosageKeyUp(Sender: TObject; var Key: Word;
1401    Shift: TShiftState);
1402  begin
1403    inherited;
1404    if (Key = VK_BACK) and (cboDosage.Text = '') then cboDosage.ItemIndex := -1;
1405  end;
1406  
1407  { cboRoute -------------------------------------- }
1408  
1409  procedure TfrmODMedNVA.cboRouteChange(Sender: TObject);
1410  begin
1411    inherited;
1412    with cboRoute do
1413      if ItemIndex > -1 then
1414      begin
1415        if Piece(Items[ItemIndex], U, 5) = '1'
1416          then tabDose.Tabs[0] := 'Dosage / Rate'
1417          else tabDose.Tabs[0] := 'Dosage';
1418      end;
1419    cboDosage.Caption := tabDose.Tabs[0];
1420    if Sender <> Self then ControlChange(Sender);
1421  end;
1422  
1423  
1424  
1425  procedure TfrmODMedNVA.cboRouteKeyUp(Sender: TObject; var Key: Word;
1426    Shift: TShiftState);
1427  begin
1428    inherited;
1429    if (Key = VK_BACK) and (cboRoute.Text = '') then cboRoute.ItemIndex := -1;
1430  end;
1431  
1432  { cboSchedule ----------------------------------- }
1433  
1434  procedure TfrmODMedNVA.cboScheduleClick(Sender: TObject);
1435  begin
1436    inherited;
1437    UpdateRelated(False);
1438  end;
1439  
1440  procedure TfrmODMedNVA.cboScheduleChange(Sender: TObject);
1441  begin
1442    inherited;
1443    UpdateRelated;
1444  end;
1445  
1446  
1447  procedure TfrmODMedNVA.cboScheduleKeyUp(Sender: TObject; var Key: Word;
1448    Shift: TShiftState);
1449  begin
1450    inherited;
1451    if (Key = VK_BACK) and (cboSchedule.Text = '') then cboSchedule.ItemIndex := -1;
1452  end;
1453  
1454  { values changing }
1455  
1456  function TfrmODMedNVA.OutpatientSig: string;
1457  var
1458    Dose, Route, Schedule: string;
1459  begin
1460    case tabDose.TabIndex of
1461    TI_DOSE:
1462      begin
1463        if ValueOf(FLD_TOTALDOSE) = ''
1464          then Dose := ValueOf(FLD_LOCALDOSE)
1465          else Dose := ValueOf(FLD_UNITNOUN);
1466        CheckDecimal(Dose);
1467        Route := ValueOf(FLD_ROUTE_EX);
1468        if (Length(Route) > 0) and (Length(FSigPrep) > 0) then Route := FSigPrep + ' ' + Route;
1469        if Length(Route) = 0 then Route := ValueOf(FLD_ROUTE_NM);
1470        Schedule := ValueOf(FLD_SCHED_EX);
1471        if Length(Schedule) = 0 then Schedule := ValueOf(FLD_SCHEDULE);
1472        Result := FSIGVerb + ' ' + Dose + ' ' + Route + ' ' + Schedule;
1473      end;
1474    end; {case}
1475  end;
1476  
1477  function TfrmODMedNVA.ConstructedDoseFields(const ADose: string; PrependName: Boolean = FALSE): string;
1478  var
1479    i, DrugIndex: Integer;
1480    UnitsPerDose, Strength: Extended;
1481    Units, Noun, AName: string;
1482  begin
1483    DrugIndex := -1;
1484    for i := 0 to Pred(FAllDrugs.Count) do
1485      if AnsiSameText(Piece(FAllDrugs[i], U, 1), FDrugID) then
1486      begin
1487        DrugIndex := i;
1488        Break;
1489      end;
1490    Strength := StrToFloatDef(Piece(FAllDrugs[DrugIndex], U, 2), 0);
1491    Units    := Piece(FAllDrugs[DrugIndex], U, 3);
1492    AName    := Piece(FAllDrugs[DrugIndex], U, 4);
1493    if FAllDoses.Count > 0
1494      then Noun := Piece(Piece(FAllDoses[0], U, 3), '&', 4)
1495      else Noun := '';
1496    if Strength > 0
1497      then UnitsPerDose := ExtractFloat(ADose) / Strength
1498      else UnitsPerDose := 0;
1499    if (UnitsPerDose > 1) and (Noun <> '') and (CharAt(Noun, Length(Noun)) <> 'S')
1500      then Noun := Noun + 'S';
1501    Result := FloatToStr(ExtractFloat(ADose)) + '&' + Units + '&' + FloatToStr(UnitsPerDose)
1502              + '&' + Noun + '&' + ADose + '&' + FDrugID + '&' + FloatToStr(Strength) + '&'
1503              + Units;
1504    if PrependName then Result := AName + U + FloatToStr(Strength) + Units + U + U +
1505                                  Result + U + ADose;
1506    Result := UpperCase(Result);
1507  end;
1508  
1509  function TfrmODMedNVA.FindDoseFields(const Drug, ADose: string): string;
1510  var
1511    i: Integer;
1512    x: string;
1513  begin
1514    Result := '';
1515    x := ADose + U + Drug + U;
1516    for i := 0 to Pred(FAllDoses.Count) do
1517    begin
1518      if AnsiSameText(x, Copy(FAllDoses[i], 1, Length(x))) then
1519      begin
1520        Result := Piece(FAllDoses[i], U, 3);
1521        Break;
1522      end;
1523    end;
1524  end;
1525  
1526  function TfrmODMedNVA.FindCommonDrug(DoseList: TStringList): string;
1527  // DoseList[n] = DoseText ^ Dispense Drug Pointer
1528  var
1529    i, j, UnitIndex: Integer;
1530    DrugStrength, DoseValue, UnitsPerDose: Extended;
1531    DrugOK, PossibleDoses, SplitTab: Boolean;
1532    ADrug, ADose, DoseFields, DoseUnits, DrugUnits: string;
1533    FoundDrugs: TStringList;
1534  
1535    procedure SaveDrug(const ADrug: string; UnitsPerDose: Extended);
1536    var
1537      i, DrugIndex: Integer;
1538      CurUnits: Extended;
1539    begin
1540      DrugIndex := -1;
1541      for i := 0 to Pred(FoundDrugs.Count) do
1542        if AnsiSameText(Piece(FoundDrugs[i], U, 1), ADrug) then DrugIndex := i;
1543      if DrugIndex = -1 then FoundDrugs.Add(ADrug + U + FloatToStr(UnitsPerDose)) else
1544      begin
1545        CurUnits := StrToFloatDef(Piece(FoundDrugs[DrugIndex], U, 2), 0);
1546        if UnitsPerDose > CurUnits
1547          then FoundDrugs[DrugIndex] := ADrug + U + FloatToStr(UnitsPerDose);
1548      end;
1549    end;
1550  
1551    procedure KillDrug(const ADrug: string);
1552    var
1553      i, DrugIndex: Integer;
1554    begin
1555      DrugIndex := -1;
1556      for i := 0 to Pred(FoundDrugs.Count) do
1557        if AnsiSameText(Piece(FoundDrugs[i], U, 1), ADrug) then DrugIndex := i;
1558      if DrugIndex > -1 then FoundDrugs.Delete(DrugIndex);
1559    end;
1560  
1561  begin
1562    Result := '';
1563    if FInptDlg then                                // inpatient dialog
1564    begin
1565      DrugOK := True;
1566      for i := 0 to Pred(DoseList.Count) do
1567      begin
1568        ADrug := Piece(DoseList[i], U, 2);
1569        if ADrug = '' then DrugOK := False;
1570        if Result = '' then Result := ADrug;
1571        if not AnsiSameText(ADrug, Result) then DrugOK := False;
1572        if not DrugOK then Break;
1573      end;
1574      
1575      if not DrugOK then Result :='';
1576    end else                                        // outpatient dialog
1577    begin
1578      // check the dose combinations for each dispense drug
1579      FoundDrugs := TStringList.Create;
1580      try
1581        if FAllDoses.Count > 0
1582          then PossibleDoses := Length(Piece(Piece(FAllDoses[0], U, 3), '&', 1)) > 0
1583          else PossibleDoses := False;
1584        for i := 0 to Pred(FAllDrugs.Count) do
1585        begin
1586          ADrug := Piece(FAllDrugs[i], U, 1);
1587          DrugOK := True;
1588          DrugStrength := StrToFloatDef(Piece(FAllDrugs[i], U, 2), 0);
1589          DrugUnits := Piece(FAllDrugs[i], U, 3);
1590          SplitTab := Piece(FAllDrugs[i], U, 5) = '1';
1591          for j := 0 to Pred(DoseList.Count) do
1592          begin
1593            ADose:= Piece(DoseList[j], U, 1);
1594            DoseFields := FindDoseFields(ADrug, ADose);  // get the idnode for the dose/drug combination
1595            if not PossibleDoses then
1596            begin
1597              if DoseFields = '' then DrugOK := False else SaveDrug(ADrug, 0);
1598            end else
1599            begin
1600              DoseValue := StrToFloatDef(Piece(DoseFields, '&', 1), 0);
1601              if DoseValue = 0 then DoseValue := ExtractFloat(ADose);
1602              UnitsPerDose := DoseValue / DrugStrength;
1603              if (Frac(UnitsPerDose) = 0) or (SplitTab and (Frac(UnitsPerDose) = 0.5))
1604                then SaveDrug(ADrug, UnitsPerDose)
1605                else DrugOK := False;
1606              // make sure this dose is using the same units as the drug
1607              if DoseFields = '' then
1608              begin
1609                for UnitIndex := 1 to Length(ADose) do
1610                  if not (ADose[UnitIndex] in ['0'..'9','.']) then Break;
1611                DoseUnits := Copy(ADose, UnitIndex, Length(ADose));
1612              end
1613              else DoseUnits := Piece(DoseFields, '&', 2);
1614              if not AnsiSameText(DoseUnits, DrugUnits) then DrugOK := False;
1615            end;
1616            if not DrugOK then
1617            begin
1618              KillDrug(ADrug);
1619              Break;
1620            end; {if not DrugOK}
1621          end; {with..for j}
1622        end; {for i}
1623        if FoundDrugs.Count > 0 then
1624        begin
1625          if not PossibleDoses then Result := Piece(FoundDrugs[0], U, 1) else
1626          begin
1627            UnitsPerDose := 99999999;
1628            for i := 0 to Pred(FoundDrugs.Count) do
1629            begin
1630              if StrToFloatDef(Piece(FoundDrugs[i], U, 2), 99999999) < UnitsPerDose then
1631              begin
1632                Result := Piece(FoundDrugs[i], U, 1);
1633                UnitsPerDose := StrToFloatDef(Piece(FoundDrugs[i], U, 2), 99999999);
1634              end; {if StrToFloatDef}
1635            end; {for i..FoundDrugs}
1636          end; {if not..else PossibleDoses}
1637        end; {if FoundDrugs}
1638      finally
1639        FoundDrugs.Free;
1640      end; {try}
1641    end; {if..else FInptDlg}
1642  end; {FindCommonDrug}
1643  
1644  procedure TfrmODMedNVA.ControlChange(Sender: TObject);
1645  var
1646    x,ADose,AUnit,ADosageText: string;
1647    DoseList: TStringList;
1648  begin
1649    inherited;
1650    if csLoading in ComponentState then Exit;       // to prevent error caused by txtRefills
1651    if Changing then Exit;
1652    if txtMed.Tag = 0 then Exit;
1653    ADose := '';
1654    AUnit := '';
1655    ADosageText := '';
1656    FUpdated := FALSE;
1657    Responses.Clear;
1658    if self.MedName = '' then Responses.Update('ORDERABLE',  1, IntToStr(txtMed.Tag), txtMed.Text)
1659    else Responses.Update('ORDERABLE',  1, IntToStr(txtMed.Tag), self.MedName);
1660    DoseList := TStringList.Create;
1661    case tabDose.TabIndex of
1662    TI_DOSE:
1663      begin
1664        if (cboDosage.ItemIndex < 0) and (Length(cboDosage.Text) > 0) then
1665        begin
1666          // try to resolve freetext dose and add it as a new item to the combobox
1667          ADosageText := cboDosage.Text;
1668          ADose := Piece(ADosageText,' ',1);
1669          Delete(ADosageText,1,Length(ADose)+1);
1670          ADosageText := ADose + Trim(ADosageText);
1671          DoseList.Add(ADosageText);
1672          FDrugID := FindCommonDrug(DoseList);
1673          if FDrugID <> '' then
1674          begin
1675            if ExtractFloat(cboDosage.Text) > 0 then
1676            begin
1677              x := ConstructedDoseFields(cboDosage.Text, TRUE);
1678              FDrugID := '';
1679              with cboDosage do ItemIndex := cboDosage.Items.Add(x);
1680            end;
1681          end;
1682        end;
1683        x := ValueOf(FLD_DOSETEXT);    Responses.Update('INSTR',    1, x,  x);
1684        x := ValueOf(FLD_DRUG_ID);     Responses.Update('DRUG',     1, x, '');
1685        x := ValueOf(FLD_DOSEFLDS);    Responses.Update('DOSE',     1, x, '');
1686        x := ValueOf(FLD_STRENGTH);
1687        // if outpt or inpt order with no total dose (i.e., topical)
1688        if (not FInptDlg) or (ValueOf(FLD_TOTALDOSE) = '')
1689                                  then Responses.Update('STRENGTH', 1, x,  x);
1690        // if no strength for dosage, use dispense drug name
1691        if Length(x) = 0 then
1692        begin
1693          x := ValueOf(FLD_DRUG_NM);
1694          if Length(x) > 0        then Responses.Update('NAME',     1, x,  x);
1695        end;
1696        x := ValueOf(FLD_ROUTE_AB);
1697        if Length(x) = 0 then x := ValueOf(FLD_ROUTE_NM);
1698        if Length(ValueOf(FLD_ROUTE_ID)) > 0
1699                                  then Responses.Update('ROUTE',    1, ValueOf(FLD_ROUTE_ID), x)
1700                                  else Responses.Update('ROUTE',    1, '', x);
1701        x := ValueOf(FLD_SCHEDULE);    Responses.Update('SCHEDULE', 1, x,  x); // CQ:7297, 7534
1702      end;
1703    end; {case TabDose.TabIndex}
1704    DoseList.Free;
1705    Responses.Update('URGENCY',   1, ValueOf(FLD_PRIOR_ID), '');
1706    Responses.Update('COMMENT',   1, TX_WPTYPE, ValueOf(FLD_COMMENT));
1707  
1708    if Length(calStart.Text) > 0 then
1709       Responses.Update('START', 1, calStart.Text, 'Start Date: ' + calStart.Text);  //cla 7-17-03
1710       
1711    x := ValueOf(FLD_STATEMENTS);
1712    Responses.Update('STATEMENTS',1, TX_WPTYPE, x);
1713  
1714  
1715   if FInptDlg then                       // inpatient orders
1716    begin
1717      Responses.Update('NOW',     1, ValueOf(FLD_NOW_ID), ValueOf(FLD_NOW_NM));
1718    end else
1719    begin
1720       x := OutpatientSig;                 Responses.Update('SIG',     1, TX_WPTYPE, x);
1721   end;
1722    memOrder.Text := Responses.OrderText;
1723  end;
1724  
1725  { complex dose ------------------------------------------------------------------------------ }
1726  
1727  { General Functions - get & set cell values}
1728  
1729  procedure FindInCombo(const x: string; AComboBox: TORComboBox);
1730  var
1731    i, Found: Integer;
1732  begin
1733    with AComboBox do
1734    begin
1735      i := 0;
1736      Found := -1;
1737      while (i < Items.Count) and (Found < 0) do
1738      begin
1739        if CompareText(Copy(DisplayText[i], 1, Length(x)), x) = 0 then Found := i;
1740        Inc(i);
1741      end; {while}
1742      if Found > -1 then
1743      begin
1744        ItemIndex := Found;
1745        Application.ProcessMessages;
1746        SelStart  := 1;
1747        SelLength := Length(Items[Found]);
1748      end else
1749      begin
1750        Text := x;
1751        SelStart := Length(x);
1752      end;
1753    end; {with AComboBox}
1754  end;
1755  
1756  procedure TfrmODMedNVA.grdDosesExit(Sender: TObject);
1757  begin
1758    inherited;
1759    UpdateRelated(FALSE);
1760    RestoreDefaultButton;
1761    RestoreCancelButton;
1762  end;
1763  
1764  function TfrmODMedNVA.ValueOf(FieldID: Integer; ARow: Integer = -1): string;
1765  var
1766    y: string;
1767    stmt: Integer;
1768  { Contents of cboDosage
1769      DrugName^Strength^NF^TDose&Units&U/D&Noun&LDose&Drug^DoseText^CostText^MaxRefills
1770    Contents of grid cells  (Only the first tab piece for each cell is drawn)
1771      Dosage    <TAB> DosageFields
1772      RouteText <TAB> IEN^RouteName^Abbreviation
1773      Schedule  <TAB> (nothing)
1774      Duration  <TAB> Duration^Units }
1775  
1776    // the following functions were created to get rid of a compile warning saying the
1777    // return value may be undefined - too much branching logic in the case statements
1778    // for the compiler to handle
1779  
1780    function GetSchedule: string;
1781    begin
1782      Result := UpperCase(cboSchedule.Text);
1783      if chkPRN.Checked then Result := Result + ' PRN';
1784      if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN'
1785        then Result := Copy(Result, 1, Length(Result) - 4);
1786    end;
1787  
1788    function GetScheduleEX: string;
1789    begin
1790      Result := '';
1791      with cboSchedule do
1792        if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2);
1793      if (Length(Result) > 0) and chkPRN.Checked then Result := Result + ' AS NEEDED';
1794      if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED'
1795        then Result := Copy(Result, 1, Length(Result) - 10);
1796    end;
1797  
1798  begin
1799    Result := '';
1800    if ARow < 0 then                                // use single dose controls
1801    begin
1802      case FieldID of
1803      FLD_DOSETEXT  : with cboDosage do
1804                        if ItemIndex > -1 then Result := Uppercase(Piece(Items[ItemIndex], U, 5))
1805                                          else Result := Uppercase(Text);
1806      FLD_LOCALDOSE : with cboDosage do
1807                        if ItemIndex > -1 then Result := Piece(Piece(Items[ItemIndex], U, 4), '&', 5)
1808                                          else Result := Uppercase(Text);
1809      FLD_STRENGTH  : with cboDosage do
1810                       if ItemIndex > -1  then Result := Piece(Items[ItemIndex], U, 2);
1811      FLD_DRUG_ID   : with cboDosage do
1812                       if ItemIndex > -1  then Result := Piece(Piece(Items[ItemIndex], U, 4), '&', 6);
1813      FLD_DRUG_NM   : with cboDosage do
1814                       if ItemIndex > -1  then Result := Piece(Items[ItemIndex], U, 1);
1815      FLD_DOSEFLDS  : with cboDosage do
1816                       if ItemIndex > -1  then Result := Piece(Items[ItemIndex], U, 4);
1817      FLD_TOTALDOSE : with cboDosage do
1818                        if ItemIndex > -1 then Result := Piece(Piece(Items[ItemIndex], U, 4), '&', 1);
1819      FLD_UNITNOUN  : with cboDosage do
1820                        if ItemIndex > -1 then Result := Piece(Piece(Items[ItemIndex], U, 4), '&', 3) + ' '
1821                                                       + Piece(Piece(Items[ItemIndex], U, 4), '&', 4);
1822      FLD_ROUTE_ID  : with cboRoute do
1823                       if ItemIndex > -1  then Result := Piece(Items[ItemIndex], U, 1);
1824      FLD_ROUTE_NM  : with cboRoute do
1825                       if ItemIndex > -1  then Result := Piece(Items[ItemIndex], U, 2)
1826                                          else Result := Text;
1827      FLD_ROUTE_AB  : with cboRoute do
1828                       if ItemIndex > -1  then Result := Piece(Items[ItemIndex], U, 3);
1829      FLD_ROUTE_EX  : with cboRoute do
1830                       if ItemIndex > -1  then Result := Piece(Items[ItemIndex], U, 4);
1831      FLD_SCHEDULE  : begin
1832                        Result := GetSchedule;
1833                      end;
1834      FLD_SCHED_EX  : begin
1835                        Result := GetScheduleEX;
1836                      end;
1837      FLD_SCHED_TYP : with cboSchedule do
1838                        if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 3);
1839      FLD_QTYDISP   : with cboDosage do
1840                        begin
1841                          if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 8);
1842                          if (Result = '') and (Items.Count > 0) then Result := Piece(Items[0], U, 8);
1843                          if Result <> ''
1844                            then Result := 'Qty (' + Result + ')'
1845                            else Result := 'Quantity';
1846                        end;
1847  
1848      FLD_COMMENT   : Result := memComment.Text;
1849  
1850      FLD_START     : Result := FormatFMDateTime('mmm dd,yy',calStart.FMDateTime);
1851  
1852      FLD_STATEMENTS : with lbStatements do
1853                       for stmt := 0 to lbStatements.Items.Count-1 do
1854                       if(lbStatements.Checked[stmt]) then
1855                       begin
1856                          y := #13#10 + lbStatements.Items.Strings[stmt] + '  ';
1857                            Result := Result + y;
1858                       end;
1859  
1860      end; {case FieldID}
1861     end;                          // use complex dose controls
1862  end;
1863  
1864  function TfrmODMedNVA.ValueOfResponse(FieldID: Integer; AnInstance: Integer = 1): string;
1865  var
1866    x: string;
1867  begin
1868    case FieldID of
1869    FLD_SCHEDULE  : Result := Responses.IValueFor('SCHEDULE', AnInstance);
1870    FLD_UNITNOUN  : begin
1871                      x := Responses.IValueFor('DOSE',   AnInstance);
1872                      Result := Piece(x, '&', 3) + ' ' + Piece(x, '&', 4);
1873                    end;
1874    FLD_DOSEUNIT  : begin
1875                      x := Responses.IValueFor('DOSE',   AnInstance);
1876                      Result := Piece(x, '&', 3);
1877                    end;
1878    FLD_DRUG_ID   : Result := Responses.IValueFor('DRUG',     AnInstance);
1879    FLD_INSTRUCT  : Result := Responses.IValueFor('INSTR',    AnInstance);
1880    FLD_SUPPLY    : Result := Responses.IValueFor('SUPPLY',   AnInstance);
1881    FLD_QUANTITY  : Result := Responses.IValueFor('QTY',      AnInstance);
1882    FLD_ROUTE_ID  : Result := Responses.IValueFor('ROUTE',    AnInstance);
1883    FLD_EXPIRE    : Result := Responses.IValueFor('DAYS',     AnInstance);
1884    FLD_ANDTHEN   : Result := Responses.IValueFor('CONJ',     AnInstance);
1885    end;
1886  end;
1887  
1888  procedure TfrmODMedNVA.UpdateStartExpires(const CurSchedule: string);
1889  var
1890    ShowText, Duration, ASchedule: string;
1891    AdminTime:    TFMDateTime;
1892    Interval, PrnPos: Integer;
1893  begin
1894    if Length(CurSchedule)=0 then Exit;
1895    ASchedule := Trim(CurSchedule);
1896    {if (Pos('^',ASchedule)=0) then  //GE  CQ7506
1897    begin
1898      PrnPos := Pos('PRN',ASchedule);
1899      if (PrnPos > 1) and (CharAt(ASchedule,PrnPos-1) <> ';') then
1900        Delete(ASchedule, PrnPos, Length(ASchedule));
1901    end  }
1902    if (Pos('^',ASchedule)>0) then
1903    begin
1904      PrnPos := Pos('PRN',ASchedule);
1905      if (PrnPos > 1) and (CharAt(ASchedule,PrnPos-1)=' ') then
1906        Delete(ASchedule, PrnPos-1, 4);
1907    end;
1908    ASchedule := Trim(ASchedule);
1909    if Length(ASchedule)>0 then
1910        LoadAdminInfo(ASchedule, txtMed.Tag, ShowText, AdminTime, Duration)
1911    else Exit;
1912    if AdminTime > 0 then
1913    begin
1914      ShowText := 'Expected First Dose: ';
1915      Interval := Trunc(FMDateTimeToDateTime(AdminTime) - FMDateTimeToDateTime(FMToday));
1916      case Interval of
1917      0: ShowText := ShowText + 'TODAY ' + FormatFMDateTime('(mmm dd, yy) at hh:nn', AdminTime);
1918      1: ShowText := ShowText + 'TOMORROW ' + FormatFMDateTime('(mmm dd, yy) at hh:nn', AdminTime);
1919      else ShowText := ShowText + FormatFMDateTime('mmm dd, yy at hh:nn', AdminTime);
1920      end;
1921    lblAdminTime.Caption := ShowText;
1922    FAdminTimeLbl := lblAdminTime.Caption;
1923    end
1924    else lblAdminTime.Caption := '';
1925  end;
1926  
1927  procedure TfrmODMedNVA.UpdateRelated(DelayUpdate: Boolean = TRUE);
1928  begin
1929    timCheckChanges.Enabled := False;               // turn off timer
1930    if DelayUpdate
1931      then timCheckChanges.Enabled := True          // restart timer
1932      else timCheckChangesTimer(Self);              // otherwise call directly
1933  end;
1934  
1935  procedure TfrmODMedNVA.timCheckChangesTimer(Sender: TObject);
1936  const
1937    UPD_NONE     = 0;
1938    UPD_QUANTITY = 1;
1939    UPD_SUPPLY   = 2;
1940  var
1941    CurUnits, CurSchedule, CurInstruct, CurDispDrug, CurDuration, TmpSchedule, x, x1: string;
1942    CurScheduleIN, CurScheduleOut: string;
1943    CurQuantity, CurSupply, i, pNum, j: Integer;
1944   { LackQtyInfo,} SaveChanging: Boolean;
1945  begin
1946    inherited;
1947    timCheckChanges.Enabled := False;
1948    ControlChange(Self);
1949    SaveChanging := Changing;
1950    Changing := TRUE;
1951    // don't allow Exit procedure so Changing gets reset appropriately
1952    CurUnits    := '';
1953    CurSchedule := '';
1954    CurDuration := '';
1955   // LackQtyInfo := False;
1956    i := Responses.NextInstance('DOSE', 0);
1957    while i > 0 do
1958    begin
1959      x := ValueOfResponse(FLD_DOSEUNIT,  i);
1960   //   if x = '' then LackQtyInfo := TRUE;  //StrToIntDef(x, 0) = 0
1961      CurUnits    := CurUnits   + x  + U;
1962      x := ValueOfResponse(FLD_SCHEDULE,  i);
1963   //   if Length(x) = 0         then LackQtyInfo := TRUE;
1964      CurScheduleOut := CurScheduleOut + x + U;
1965      x1 := ValueOf(FLD_SEQUENCE,i);
1966      if Length(x1)>0 then
1967      begin
1968        X1 := CharAt(X1,1);
1969        CurScheduleIn := CurScheduleIn + x1 + ';' + x + U;
1970      end
1971      else
1972        CurScheduleIn := CurScheduleIn + ';' + x + U;
1973      x := ValueOfResponse(FLD_EXPIRE,    i);
1974      CurDuration := CurDuration + x + '~';
1975      x := ValueOfResponse(FLD_ANDTHEN,   i);
1976      CurDuration := CurDuration + x + U;
1977      x := ValueOfResponse(FLD_DRUG_ID,   i);
1978      CurDispDrug := CurDispDrug + x + U;
1979      x := ValueOfResponse(FLD_INSTRUCT,  i);
1980      CurInstruct := CurInstruct + x + U;
1981      i := Responses.NextInstance('DOSE', i);
1982    end;
1983  
1984    pNum := 1;
1985    while Length( Piece(CurScheduleIn,U,pNum)) > 0 do
1986      pNum := pNum + 1;
1987    if Length(Piece(CurScheduleIn,U,pNum)) < 1 then
1988      for j := 1 to pNum - 1 do
1989      begin
1990        if j = pNum -1 then
1991          TmpSchedule := TmpSchedule + ';' + Piece(Piece(CurScheduleIn,U,j),';',2)
1992        else
1993          TmpSchedule := TmpSchedule + Piece(CurScheduleIn,U,j) + U
1994      end;
1995    CurScheduleIn := TmpSchedule;
1996    CurQuantity := StrToIntDef(ValueOfResponse(FLD_QUANTITY) ,0);
1997    CurSupply   := StrToIntDef(ValueOfResponse(FLD_SUPPLY)   ,0);
1998    if FInptDlg then
1999    begin
2000      CurSchedule := CurScheduleIn;
2001      if Pos('^',CurSchedule)>0 then
2002      begin
2003        if Pos('PRN',Piece(CurSchedule,'^',1))>0 then
2004          if lblAdminTime.Visible then
2005            lblAdminTime.Caption := '';
2006      end;
2007      if CurSchedule <> FLastSchedule then UpdateStartExpires(CurSchedule);
2008      if Responses.EventType in ['A','D','T','M','O'] then lblAdminTime.Visible := False;
2009    end;
2010    if not FInptDlg then
2011    begin
2012      CurSchedule := CurScheduleOut;
2013    end;
2014  
2015    FLastUnits    := CurUnits;
2016    FLastSchedule := CurSchedule;
2017    FLastDispDrug := CurDispDrug;
2018    FLastQuantity := CurQuantity;
2019    FLastSupply   := CurSupply;
2020    if (ActiveControl <> nil) and (ActiveControl.Parent <> cboDosage)
2021      then cboDosage.Text := Piece(cboDosage.Text, TAB, 1);
2022    Changing := SaveChanging;
2023    if FUpdated then ControlChange(Self);
2024  end;
2025  
2026  procedure TfrmODMedNVA.cmdAcceptClick(Sender: TObject);
2027  begin
2028    cmdAccept.SetFocus;
2029    inherited;
2030  end;
2031  procedure TfrmODMedNVA.CheckDecimal(var AStr: string);
2032  var
2033    Number: double;
2034    DUName,TabletNum,tempStr: string;
2035    ToWord: string;
2036    ie,code: integer;
2037  begin
2038    ToWord := '';
2039    tempStr := AStr;
2040    TabletNum := Piece(AStr,' ',1);
2041    if CharAt(TabletNum,1)='.' then
2042    begin
2043      if CharAt(TabletNum,2) in ['0','1','2','3','4','5','6','7','8','9'] then
2044      begin
2045        TabletNum := '0' + TabletNum;
2046        AStr := '0' + AStr;
2047      end;
2048    end;
2049    DUName := Piece(AStr,' ',2);
2050    if Pos('TABLET',upperCase(DUName))= 0 then
2051      Exit;
2052    if (Length(TabletNum)>0) and (Length(DUName)>0) then
2053    begin
2054      if CharAt(TabletNum,1) <> '0' then
2055      begin
2056        Val(TabletNum, ie, code);
2057        if ie = 0 then begin end;
2058        if code <> 0 then
2059          Exit;
2060      end;
2061      try
2062        begin
2063          Number := StrToFloat(TabletNum);
2064          if Number = 0.5 then
2065            ToWord := 'ONE-HALF';
2066          if ( Number >= 0.333 ) and  ( Number <= 0.334 ) then
2067            ToWord := 'ONE-THIRD';
2068          if Number = 0.25 then
2069            ToWord := 'ONE-FOURTH';
2070          if ( Number >= 0.66 ) and ( Number <= 0.67 ) then
2071            ToWord := 'TWO-THIRDS';
2072          if Number = 0.75 then
2073            ToWord := 'THREE-FOURTHS';
2074          if Number = 1 then
2075            ToWord := 'ONE';
2076          if Number = 2 then
2077            ToWord := 'TWO';
2078          if Number = 3 then
2079            ToWord := 'THREE';
2080          if Number = 4 then
2081            ToWord := 'FOUR';
2082          if Number = 5 then
2083            ToWord := 'FIVE';
2084          if Number = 6 then
2085            ToWord := 'SIX';
2086          if (Length(ToWord) > 0) then
2087             AStr :=  ToWord + ' ' + DUName;
2088        end
2089      except
2090        on EConvertError do AStr := tempStr;
2091      end;
2092    end;
2093  end;
2094  
2095  procedure TfrmODMedNVA.chkPRNClick(Sender: TObject);
2096  var
2097    tempSch: string;
2098    PRNPos: integer;
2099  begin
2100    inherited;
2101    {if chkPRN.Checked then lblAdminTime.Caption := ''
2102    else
2103    begin
2104      lblAdminTime.Caption := FAdminTimeLbl;
2105    end;
2106    ControlChange(Self);
2107    }
2108    if chkPRN.Checked then
2109    begin
2110       lblAdminTime.Caption := '';
2111       PrnPos := Pos('PRN',cboSchedule.Text);
2112       if (PrnPos < 1) then
2113          UpdateStartExpires(cboSchedule.Text + ' PRN');
2114    end
2115    else
2116    begin
2117      if Length(Trim(cboSchedule.Text))>0 then
2118      begin
2119        tempSch := ';'+Trim(cboSchedule.Text);
2120        UpdateStartExpires(tempSch);
2121      end;
2122      lblAdminTime.Caption := FAdminTimeLbl;
2123      
2124    end;
2125    ControlChange(Self);
2126  end;
2127  
2128  procedure TfrmODMedNVA.grdDosesKeyDown(Sender: TObject; var Key: Word;
2129    Shift: TShiftState);
2130  begin
2131    inherited;
2132    case Key of
2133    VK_ESCAPE:
2134      begin
2135        ActiveControl := FindNextControl(Sender as TWinControl, False, True, False); //Previous control
2136        Key := 0;
2137      end;
2138    VK_TAB:
2139      begin
2140        if ssShift in Shift then
2141        begin
2142          ActiveControl := tabDose; //Previeous control
2143          Key := 0;
2144        end
2145        else if ssCtrl	in Shift then
2146        begin
2147          ActiveControl := memComment;
2148          Key := 0;
2149        end;
2150      end;
2151    end;
2152  end;
2153  
2154  procedure TfrmODMedNVA.grdDosesEnter(Sender: TObject);
2155  begin
2156    inherited;
2157    DisableDefaultButton(self);
2158    DisableCancelButton(self);
2159  end;
2160  
2161  function TfrmODMedNVA.DisableCancelButton(Control: TWinControl): boolean;
2162  var
2163    i: integer;
2164  begin
2165    if (Control is TButton) and TButton(Control).Cancel then begin
2166      result := True;
2167      FDisabledCancelButton := TButton(Control);
2168      TButton(Control).Cancel := False;
2169    end else begin
2170      result := False;
2171      for i := 0 to Control.ControlCount-1 do
2172        if (Control.Controls[i] is TWinControl) then
2173          if DisableCancelButton(TWinControl(Control.Controls[i])) then begin
2174            result := True;
2175            break;
2176          end;
2177    end;
2178  end;
2179  
2180  function TfrmODMedNVA.DisableDefaultButton(Control: TWinControl): boolean;
2181  var
2182    i: integer;
2183  begin
2184    if (Control is TButton) and TButton(Control).Default then begin
2185      result := True;
2186      FDisabledDefaultButton := TButton(Control);
2187      TButton(Control).Default := False;
2188    end else begin
2189      result := False;
2190      for i := 0 to Control.ControlCount-1 do
2191        if (Control.Controls[i] is TWinControl) then
2192          if DisableDefaultButton(TWinControl(Control.Controls[i])) then begin
2193            result := True;
2194            break;
2195          end;
2196    end;
2197  end;
2198  
2199  procedure TfrmODMedNVA.RestoreCancelButton;
2200  begin
2201    if Assigned(FDisabledCancelButton) then begin
2202      FDisabledCancelButton.Cancel := True;
2203      FDisabledCancelButton := nil;
2204    end;
2205  end;
2206  
2207  procedure TfrmODMedNVA.RestoreDefaultButton;
2208  begin
2209    if Assigned(FDisabledDefaultButton) then begin
2210      FDisabledDefaultButton.Default := True;
2211      FDisabledDefaultButton := nil;
2212    end;
2213  end;
2214  
2215  procedure TfrmODMedNVA.pnlMessageEnter(Sender: TObject);
2216  begin
2217    inherited;
2218    DisableDefaultButton(self);
2219    DisableCancelButton(self);
2220  end;
2221  
2222  procedure TfrmODMedNVA.pnlMessageExit(Sender: TObject);
2223  begin
2224    inherited;
2225    RestoreDefaultButton;
2226    RestoreCancelButton;
2227  end;
2228  
2229  procedure TfrmODMedNVA.memMessageKeyDown(Sender: TObject; var Key: Word;
2230    Shift: TShiftState);
2231  begin
2232    inherited;
2233    if (Key = VK_RETURN) or (Key = VK_ESCAPE) then
2234    begin
2235      Perform(WM_NEXTDLGCTL, 0, 0);
2236      Key := 0;
2237    end;
2238  end;
2239  
2240  procedure TfrmODMedNVA.FormResize(Sender: TObject);
2241  begin
2242    inherited;
2243    pnlFields.Height := cmdAccept.Top - 4 - pnlFields.Top;
2244  end;
2245  
2246  function TfrmODMedNVA.GetCacheChunkIndex(idx: integer): integer;
2247  begin
2248    Result := idx div MED_CACHE_CHUNK_SIZE;
2249  end;
2250  
2251  procedure TfrmODMedNVA.lstQuickData(Sender: TObject; Item: TListItem);
2252  var
2253    x: string;
2254  begin
2255      x := FQuickItems[Item.Index];
2256      Item.Caption := Piece(x, U, 2);
2257      Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0));
2258  end;
2259  
2260  procedure TfrmODMedNVA.LoadOTCStatements(Dest: TStrings);
2261  var tmplst: TStringList;
2262    s: string;
2263    i :Integer;
2264  begin
2265      tmplst := TStringList.Create;
2266      tmplst.Clear;
2267      tCallV(tmplst, 'ORWPS REASON', [nil]);
2268      if tmplst.Count > 0 then
2269      begin
2270        //  sort := tmplst.Strings[0];
2271          for i := 0 to tmplst.Count-1 do
2272          begin
2273              s:= tmplst.Strings[i];
2274              tmplst.Strings[i] := Piece(s,U,2);
2275          end;
2276          FastAssign(tmplst, Dest);
2277      end;
2278   end;
2279  
2280  function TfrmODMedNVA.FindQuickOrder(const x: string): Integer;
2281  var
2282    i: Integer;
2283  begin
2284    Result := -1;
2285    if x = '' then Exit;
2286    for i := 0 to Pred(FQuickItems.Count) do
2287    begin
2288      if (Result > -1) or (FQuickItems[i] = '') then Break;
2289      if AnsiCompareText(x, Copy(Piece(FQuickItems[i],'^',2), 1, Length(x))) = 0 then Result := i;
2290    end;
2291  end;
2292  procedure TfrmODMedNVA.lbStatementsClickCheck(Sender: TObject;
2293    Index: Integer);
2294  begin
2295    inherited;
2296     ControlChange(self);
2297  end;
2298  
2299  procedure TfrmODMedNVA.lstChange(Sender: TObject; Item: TListItem;
2300    Change: TItemChange);
2301  begin
2302    inherited;
2303    btnSelect.Enabled := (lstAll.ItemIndex > -1) or
2304                         ((lstQuick.ItemIndex > -1) and
2305                         (Assigned(lstQuick.Items[lstQuick.ItemIndex].Data)) and
2306                         (Integer(lstQuick.Selected.Data) > 0)) ;
2307    if (btnSelect.Enabled) and (FRemoveText) then
2308      txtMed.Text := '';
2309  end;
2310  
2311  procedure TfrmODMedNVA.FormKeyPress(Sender: TObject; var Key: Char);
2312  begin
2313   if (Key = #13) and (ActiveControl = txtMed) then
2314    Key := #0   //Don't let the base class turn it into a forward tab!
2315   else
2316    inherited;
2317  end;
2318  
2319  function OIForNVA(AnIEN: Integer; ForNonVAMed: Boolean; HavePI: Boolean; PKIActive: Boolean): TStrings;
2320  var
2321    PtType: Char;
2322    NeedPI: Char;
2323    IsPKIActive: Char;
2324  begin
2325    if HavePI then NeedPI := 'Y' else NeedPI := 'N';
2326    if ForNonVAMed then PtType := 'X' else PtType := 'O';
2327    if PKIActive then IsPKIActive := 'Y' else IsPKIActive := 'N';
2328    CallV('ORWDPS2 OISLCT', [AnIEN, PtType, Patient.DFN, NeedPI, IsPKIActive]);
2329    Result := RPCBrokerV.Results;
2330  end;
2331  
2332  procedure CheckAuthForNVAMeds(var x: string);
2333  begin
2334    x := Piece(sCallV('ORWDPS32 AUTHNVA', [Encounter.Provider]), U, 2);
2335  end;
2336  
2337  function TfrmODMedNVA.isUniqueQuickOrder(iText: string): Boolean;
2338  var
2339    counter,i: Integer;
2340  begin
2341    counter := 0;
2342    Result := False;
2343    if iText = '' then Exit;
2344    for i := 0 to FQuickItems.Count-1 do
2345      if AnsiCompareText(iText, Copy(Piece(FQuickItems[i],'^',2), 1, Length(iText))) = 0 then
2346        Inc(counter);               //Found a Match
2347    Result := counter = 1;
2348  end;
2349  
2350  procedure TfrmODMedNVA.DispOrderMessage(const AMessage: string);
2351  begin
2352    if ContainsVisibleChar(AMessage) then
2353    begin
2354      image1.Visible := True;
2355      memDrugMsg.Visible := True;
2356      image1.Picture.Icon.Handle := LoadIcon(0, IDI_ASTERISK);
2357      memDrugMsg.Lines.Clear;
2358      memDrugMsg.Lines.SetText(PChar(AMessage));
2359      if fShrinkDrugMsg then
2360      begin
2361        pnlBottom.Height := pnlBottom.Height + memDrugMsg.Height + 2;
2362        fShrinkDrugMsg := False;
2363      end;
2364    end else
2365    begin
2366      image1.Visible := False;
2367      memDrugMsg.Visible := False;
2368      if not fShrinkDrugMsg then
2369    //  begin
2370    //    pnlBottom.Height := pnlBottom.Height - memDrugMsg.Height - 2;
2371        fShrinkDrugMsg := True;
2372   //   end;
2373    end;
2374  end;
2375  
2376  end.

Module Calls (2 levels)


fODMedNVA
 ├fODBase
 │ ├fAutoSz
 │ ├uConst
 │ ├rOrders
 │ ├rODBase
 │ ├uCore
 │ ├UBAGlobals
 │ ├UBACore
 │ ├fOCAccept
 │ ├uODBase
 │ ├rCore
 │ ├rMisc
 │ ├fTemplateDialog
 │ ├uEventHooks
 │ ├uTemplates
 │ ├rConsults
 │ ├fOrders
 │ ├uOrders
 │ ├fFrame
 │ ├fODDietLT
 │ └rODDiet
 ├uConst
 ├XuDigSigSC_TLB
 ├uOrders...
 ├rCore...
 ├uCore...
 ├rODMeds
 │ ├uCore...
 │ └uConst
 ├rODBase...
 ├rOrders...
 ├fRptBox
 │ ├fFrame...
 │ ├fBase508Form
 │ ├uReports
 │ └rReports
 ├fODMedOIFA
 │ ├fBase508Form...
 │ ├rODMeds...
 │ └rMisc...
 └fFrame...

Module Called-By (2 levels)


                   fODMedNVA
                   uOrders┘ 
                   uCore┤   
                 fODBase┤   
                 rODBase┤   
                  fFrame┤   
                 fOrders┤   
             fOrdersSign┤   
                   fMeds┤   
               fARTAllgy┤   
                  fNotes┤   
               fConsults┤   
         fReminderDialog┤   
                 fReview┤   
            fOrdersRenew┤   
               fOrdersCV┤   
                 fODMeds┤   
                 fOMNavA┤   
         fOrderSaveQuick┤   
                  fOMSet┤   
          fOrdersRelease┤   
                 fOMHTML┤   
            fODMedNVA...┤   
fODChangeUnreleasedRenew┤   
          fOrdersOnChart┤   
         fODReleaseEvent┤   
               fODActive┘