Module

fODBBank

Path

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

Last Modified

7/15/2014 3:26:40 PM

Units Used in Interface

Name Comments
fODBase -
uConst -

Units Used in Implementation

Name Comments
fLabCollTimes -
fODLabImmedColl -
fODLabOthCollSamp -
fODLabOthSpec -
fRptBox -
rCore -
rODBase -
rODLab -
rOrders -
uCore -
uODBase -

Classes

Name Comments
TCollSamp -
TfrmODBBank -
TLabTest -

Procedures

Name Owner Declaration Scope Comments
btnCancelCommentClick TfrmODBBank procedure btnCancelCommentClick(Sender: TObject); Public/Published -
btnRemoveAllClick TfrmODBBank procedure btnRemoveAllClick(Sender: TObject); Public/Published -
btnRemoveClick TfrmODBBank procedure btnRemoveClick(Sender: TObject); Public/Published -
btnUpdateCommentsClick TfrmODBBank procedure btnUpdateCommentsClick(Sender: TObject); Public/Published -
calCollTimeChange TfrmODBBank procedure calCollTimeChange(Sender: TObject); Public/Published -
calCollTimeEnter TfrmODBBank procedure calCollTimeEnter(Sender: TObject); Public/Published -
calWantTimeChange TfrmODBBank procedure calWantTimeChange(Sender: TObject); Public/Published -
calWantTimeEnter TfrmODBBank procedure calWantTimeEnter(Sender: TObject); Public/Published -
cboAvailCompEnter TfrmODBBank procedure cboAvailCompEnter(Sender: TObject); Public/Published -
cboAvailCompExit TfrmODBBank procedure cboAvailCompExit(Sender: TObject); Public/Published -
cboAvailCompNeedData TfrmODBBank procedure cboAvailCompNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
cboAvailCompSelect TfrmODBBank procedure cboAvailCompSelect(Sender: TObject); Public/Published -
cboAvailTestEnter TfrmODBBank procedure cboAvailTestEnter(Sender: TObject); Public/Published -
cboAvailTestExit TfrmODBBank procedure cboAvailTestExit(Sender: TObject); Public/Published -
cboAvailTestNeedData TfrmODBBank procedure cboAvailTestNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
cboAvailTestSelect TfrmODBBank procedure cboAvailTestSelect(Sender: TObject); Public/Published -
cboCollTimeChange TfrmODBBank procedure cboCollTimeChange(Sender: TObject); Public/Published -
cboCollTimeEnter TfrmODBBank procedure cboCollTimeEnter(Sender: TObject); Public/Published -
cboCollTypeChange TfrmODBBank procedure cboCollTypeChange(Sender: TObject); Public/Published -
cboCollTypeClick TfrmODBBank procedure cboCollTypeClick(Sender: TObject); Public/Published -
cboCollTypeEnter TfrmODBBank procedure cboCollTypeEnter(Sender: TObject); Public/Published -
cboModifiersChange TfrmODBBank procedure cboModifiersChange(Sender: TObject); Public/Published -
cboModifiersEnter TfrmODBBank procedure cboModifiersEnter(Sender: TObject); Public/Published -
cboQuickClick TfrmODBBank procedure cboQuickClick(Sender: TObject); Public/Published -
cboReasonsChange TfrmODBBank procedure cboReasonsChange(Sender: TObject); Public/Published -
cboReasonsEnter TfrmODBBank procedure cboReasonsEnter(Sender: TObject); Public/Published -
cboReasonsExit TfrmODBBank procedure cboReasonsExit(Sender: TObject); Public/Published -
cboSurgeryChange TfrmODBBank procedure cboSurgeryChange(Sender: TObject); Public/Published -
cboSurgeryClick TfrmODBBank procedure cboSurgeryClick(Sender: TObject); Public/Published -
cboUrgencyChange TfrmODBBank procedure cboUrgencyChange(Sender: TObject); Public/Published -
cboUrgencyExit TfrmODBBank procedure cboUrgencyExit(Sender: TObject); Public/Published -
ChangeCollSamp TLabTest procedure ChangeCollSamp(CollSampIEN: Integer); Public/Published -
ChangeComment TLabTest procedure ChangeComment(const CommentText: string); Public/Published -
ChangeSpecimen TLabTest procedure ChangeSpecimen(const SpecimenIEN: string); Public/Published -
chkConsentClick TfrmODBBank procedure chkConsentClick(Sender: TObject); Public/Published -
cmdAcceptClick TfrmODBBank procedure cmdAcceptClick(Sender: TObject); Public/Published -
cmdImmedCollClick TfrmODBBank procedure cmdImmedCollClick(Sender: TObject); Public/Published -
DetermineCollectionDefaults TfrmODBBank procedure DetermineCollectionDefaults(Responses: TResponses); Public -
DisableCommentPanels TfrmODBBank procedure DisableCommentPanels; Public/Published -
DisableComponentControls TfrmODBBank procedure DisableComponentControls; Public/Published -
DisableDiagTestControls TfrmODBBank procedure DisableDiagTestControls; Public/Published -
EnableComponentControls TfrmODBBank procedure EnableComponentControls; Public/Published -
EnableDiagTestControls TfrmODBBank procedure EnableDiagTestControls; Public/Published -
ExtractModifiers TfrmODBBank procedure ExtractModifiers(OutList:TStrings; AList:TStrings); Protected -
ExtractMSBOS TfrmODBBank procedure ExtractMSBOS(OutList:TStrings; AList:TStrings); Protected -
ExtractOther TfrmODBBank procedure ExtractOther(OutList:TStrings; AList:TStrings); Protected -
ExtractPatientInfo TfrmODBBank procedure ExtractPatientInfo(OutList:TStrings; AList:TStrings); Protected -
ExtractReasons TfrmODBBank procedure ExtractReasons(OutList:TStrings; AList:TStrings); Protected -
ExtractSpecimen TfrmODBBank procedure ExtractSpecimen(OutList:TStrings; AList:TStrings); Protected -
ExtractSpecimens TfrmODBBank procedure ExtractSpecimens(OutList:TStrings; AList:TStrings); Protected -
ExtractSurgeries TfrmODBBank procedure ExtractSurgeries(OutList:TStrings; AList:TStrings); Protected -
ExtractTests TfrmODBBank procedure ExtractTests(OutList:TStrings; AList:TStrings); Protected -
ExtractTNSOrders TfrmODBBank procedure ExtractTNSOrders(OutList:TStrings; AList:TStrings); Protected -
ExtractTypeScreen TfrmODBBank procedure ExtractTypeScreen(OutList:TStrings; AList:TStrings); Protected -
ExtractUrgencies TfrmODBBank procedure ExtractUrgencies(OutList:TStrings; AList:TStrings); Protected -
FillCollSampList TLabTest procedure FillCollSampList(LoadData: TStringList; DfltCollSamp: Integer); Public/Published
1  2        3         4       5         6          7         8          9               10   
n^IEN^CollSampName^SpecIEN^TubeTop^MinInterval^MaxPerDay^LabCollect^SampReqCommentIEN;name^SpecName
FormCreate TfrmODBBank procedure FormCreate(Sender: TObject); Public/Published -
FormDestroy TfrmODBBank procedure FormDestroy(Sender: TObject); Public/Published -
FormShow TfrmODBBank procedure FormShow(Sender: TObject); Public/Published -
GetAllCollSamples TfrmODBBank procedure GetAllCollSamples(AComboBox: TORComboBox); Protected -
GetAllSpecimens TfrmODBBank procedure GetAllSpecimens(AComboBox: TORComboBox); Protected -
InitDialog TfrmODBBank procedure InitDialog; override; Protected -
LoadAllSamples TLabTest procedure LoadAllSamples; Public/Published -
LoadCollSamp TLabTest procedure LoadCollSamp(AComboBox: TORComboBox); Public/Published Loads the collection sample combo box, expects CollSamp to already be set to default
LoadCollType TfrmODBBank procedure LoadCollType(AComboBox:TORComboBox); Protected -
LoadModifiers TfrmODBBank procedure LoadModifiers(AComboBox:TORComboBox); Protected -
LoadReasons TfrmODBBank procedure LoadReasons(AComboBox:TORComboBox); Protected -
LoadRequiredComment TfrmODBBank procedure LoadRequiredComment(CmtType: integer); Public -
LoadSpecimen TLabTest procedure LoadSpecimen(AComboBox: TORComboBox); Public/Published Loads specimen combo box, if SpecimenList is empty, use 'E' xref on 61 ??
LoadUrgencies TfrmODBBank procedure LoadUrgencies(AComboBox:TORComboBox); Protected -
LoadUrgency TLabTest procedure LoadUrgency(CollType: string; AComboBox:TORComboBox); Public/Published -
lvSelectionListClick TfrmODBBank procedure lvSelectionListClick(Sender: TObject); Public/Published -
memDiagCommentChange TfrmODBBank procedure memDiagCommentChange(Sender: TObject); Public/Published -
pgeProductChange TfrmODBBank procedure pgeProductChange(Sender: TObject); Public/Published -
pnlBloodComponentsClick TfrmODBBank procedure pnlBloodComponentsClick(Sender: TObject); Public/Published -
pnlBloodComponentsEnter TfrmODBBank procedure pnlBloodComponentsEnter(Sender: TObject); Public/Published -
pnlBloodComponentsExit TfrmODBBank procedure pnlBloodComponentsExit(Sender: TObject); Public/Published -
pnlDiagnosticTestsClick TfrmODBBank procedure pnlDiagnosticTestsClick(Sender: TObject); Public/Published -
pnlDiagnosticTestsEnter TfrmODBBank procedure pnlDiagnosticTestsEnter(Sender: TObject); Public/Published -
pnlDiagnosticTestsExit TfrmODBBank procedure pnlDiagnosticTestsExit(Sender: TObject); Public/Published -
ReadServerVariables TfrmODBBank procedure ReadServerVariables; Private -
SetCollSampDflts TLabTest procedure SetCollSampDflts; Public/Published -
SetError - procedure SetError(const x: string); Local -
SetError - procedure SetError(const x: string); Local -
SetOnQuickOrder TfrmODBBank procedure SetOnQuickOrder; Private -
SetupCollTimes TfrmODBBank procedure SetupCollTimes(CollType: string); Protected -
SetupDialog TfrmODBBank procedure SetupDialog(OrderAction: Integer; const ID: string); override; Public -
tQuantityChange TfrmODBBank procedure tQuantityChange(Sender: TObject); Public/Published -
tQuantityClick TfrmODBBank procedure tQuantityClick(Sender: TObject); Public/Published -
tQuantityEnter TfrmODBBank procedure tQuantityEnter(Sender: TObject); Public/Published -
txtImmedCollEnter TfrmODBBank procedure txtImmedCollEnter(Sender: TObject); Public/Published -
Validate TfrmODBBank procedure Validate(var AnErrMsg: string); override; Protected -
ValidateAdd TfrmODBBank procedure ValidateAdd(var AnErrMsg: string); Protected -

Functions

Name Owner Declaration Scope Comments
IndexOfCollSamp TLabTest function IndexOfCollSamp(CollSampIEN: Integer): Integer; Public/Published -
LabCanCollect TLabTest function LabCanCollect: Boolean; Public/Published -
NameOfCollSamp TLabTest function NameOfCollSamp: string; Public/Published -
NameOfSpecimen TLabTest function NameOfSpecimen: string; Public/Published -
NameOfUrgency TLabTest function NameOfUrgency: string; Public/Published -
ObtainCollSamp TLabTest function ObtainCollSamp: Boolean; Public/Published -
ObtainComment TLabTest function ObtainComment: Boolean; Public/Published -
ObtainSpecimen TLabTest function ObtainSpecimen: Boolean; Public/Published -
ObtainUrgency TLabTest function ObtainUrgency: Boolean; Public/Published -
SpecimenNeeded TfrmODBBank function SpecimenNeeded(OutList:TStrings; AList:TStrings; CompID:integer): Boolean; Protected -
ValidAdd TfrmODBBank function ValidAdd: Boolean; Protected -
ValidCollTime TfrmODBBank function ValidCollTime(UserEntry: string): string; Protected -

Global Variables

Name Type Declaration Comments
ALabTest TLabTest ALabTest: TLabTest; -
frmODBBank TfrmODBBank frmODBBank: TfrmODBBank; -
LRFDATE UnicodeString LRFDATE : string; The default collection time (NOW,NEXT,AM,PM,T...)
LRFSAMP UnicodeString LRFSAMP : string; The default sample (ptr)
LRFSCH UnicodeString LRFSCH : string; The default schedule? (ONE TIME, QD, ...)
LRFSPEC UnicodeString LRFSPEC : string; The default specimen (ptr)
LRFURG UnicodeString LRFURG : string; The default urgency (number) TRY '2'
LRFZX UnicodeString LRFZX : string; The default collection type (LC,WC,SP,I)
LRORDERMODE Integer LRORDERMODE : Integer; The mode being used to order (component or diagnostic test)
uChangingMSBOS Boolean uChangingMSBOS: boolean; -
uComponentSelected Boolean uTestSelected, uComponentSelected: Boolean; Used on Validate
uDfltCollType UnicodeString uDfltCollType, uReason: string; -
uDfltUrgency Integer uDfltUrgency: Integer; Default Urgency
uGetTnS Integer uSpecimen, uGetTnS: Integer; Set to 1 if a specimen for test is already in lab... no need to collect
uModifierList TStringList uModifierList: TStringList; List of Modifiers
uRaw TStringList uRaw: TStringList; Results Array
uReason UnicodeString uDfltCollType, uReason: string; -
uReasonsList TStringList uReasonsList: TStringList; List of Reasons for Request
uSelectedItems TStringList uSelectedItems: TStringList; Selected Items in ListView- if TestYes =1 then test else component
uSelSurgery Integer uSelSurgery: Integer; Selected Surgery for Blood order
uSelUrgency UnicodeString uSelUrgency: String; Previously Selected Urgency - Used when components have been added for specific urgency
UserHasLRLABKey Boolean UserHasLRLABKey: boolean; -
uSpecimen Integer uSpecimen, uGetTnS: Integer; Set to 1 if a specimen for test is already in lab... no need to collect
uTestSelected Boolean uTestSelected, uComponentSelected: Boolean; Used on Validate
uTestsForResults TStringList uTestsForResults: TStringList; List of tests to show results
uTNSOrders TStringList uTNSOrders: TStringList; List of Current orders for Type & Screen
uUrgencyList TStringList uUrgencyList: TStringList; List of Urgencies
uVBECList TStringList uVBECList: TStringList;
TestYes(1)^Test-Component(2)^Qty(3)^Modifier(4)^Specimen(5,6)^CollTime(7)^CollType(8)

List of items from VBEC api

Constants

Name Declaration Scope Comments
CmtType array[0..6] of string = ('ANTICOAGULATION','DOSE/DRAW TIMES','ORDER COMMENT', Interfaced -
TI_COMPONENT 1 Global -
TI_INFO 0 Global Corresponds with pgeProduct TabIndex
TI_RESULTS 2 Global -
TORDER_MODE_COMP 2 Global -
TORDER_MODE_DIAG 1 Global -
TORDER_MODE_INFO 0 Global -
TX_NO_IMMED 'Immediate collect is not available for this test/sample' Global -
TX_NO_IMMED_CAP 'Invalid Collection Type' Global -
TX_NO_TEST 'A Lab Test must be specified.' Global -


Module Source

1     unit fODBBank;
2     interface
3     
4     uses
5       SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
6       Forms, Dialogs, StdCtrls, ORCtrls, ORfn, fODBase, ExtCtrls, ComCtrls, uConst,
7       ORDtTm, Buttons, Menus, ImgList, VA508AccessibilityManager, VAUtils;
8     
9     type
10      TfrmODBBank = class(TfrmODBase)
11        dlgLabCollTime: TORDateTimeDlg;
12        ORWanted: TORDateTimeDlg;
13        pnlComments: TPanel;
14        btnUpdateComments: TButton;
15        btnCancelComment: TButton;
16        lblOrdComment: TLabel;
17        pgeProduct: TPageControl;
18        TabInfo: TTabSheet;
19        edtInfo: TCaptionRichEdit;
20        TabDiag: TTabSheet;
21        lblReqComment: TOROffsetLabel;
22        TabResults: TTabSheet;
23        edtResults: TCaptionRichEdit;
24        pnlFields: TPanel;
25        lblDiagComment: TOROffsetLabel;
26        lblUrgency: TLabel;
27        lblReason: TLabel;
28        lblSurgery: TLabel;
29        cboUrgency: TORComboBox;
30        chkConsent: TCheckBox;
31        cboSurgery: TORComboBox;
32        pnlSelect: TPanel;
33        pnlDiagnosticTests: TGroupBox;
34        cboAvailTest: TORComboBox;
35        pnlBloodComponents: TGroupBox;
36        lblQuantity: TLabel;
37        lblModifiers: TLabel;
38        cboAvailComp: TORComboBox;
39        tQuantity: TEdit;
40        cboModifiers: TORComboBox;
41        GroupBox1: TGroupBox;
42        cboQuick: TORComboBox;
43        pnlSelectedTests: TGroupBox;
44        lvSelectionList: TCaptionListView;
45        btnRemove: TButton;
46        btnRemoveAll: TButton;
47        cboReasons: TORComboBox;
48        lblRequiredField: TLabel;
49        memDiagComment: TRichEdit;
50        lblCollType: TLabel;
51        cboCollType: TORComboBox;
52        lblCollTime: TLabel;
53        cboCollTime: TORComboBox;
54        calWantTime: TORDateBox;
55        lblWanted: TLabel;
56        calCollTime: TORDateBox;
57        txtImmedColl: TCaptionEdit;
58        pnlCollTimeButton: TKeyClickPanel;
59        lblTNS: TLabel;
60        lblNoBloodReq: TLabel;
61        cmdImmedColl: TSpeedButton;
62        Splitter1: TSplitter;
63        procedure FormCreate(Sender: TObject);
64        procedure cboAvailTestSelect(Sender: TObject);
65        procedure cboAvailCompSelect(Sender: TObject);
66        procedure DisableCommentPanels;
67        procedure DisableComponentControls;
68        procedure DisableDiagTestControls;
69        procedure EnableComponentControls;
70        procedure EnableDiagTestControls;
71        procedure cboAvailTestExit(Sender: TObject);
72        procedure cboAvailCompExit(Sender: TObject);
73        procedure cboAvailTestNeedData(Sender: TObject;
74          const StartFrom: String; Direction, InsertAt: Integer);
75        procedure cboAvailCompNeedData(Sender: TObject;
76          const StartFrom: String; Direction, InsertAt: Integer);
77        procedure cmdImmedCollClick(Sender: TObject);
78        procedure pgeProductChange(Sender: TObject);
79        procedure cboCollTypeChange(Sender: TObject);
80        procedure FormDestroy(Sender: TObject);
81        procedure btnRemoveClick(Sender: TObject);
82        procedure btnRemoveAllClick(Sender: TObject);
83        procedure cmdAcceptClick(Sender: TObject);
84        procedure calWantTimeChange(Sender: TObject);
85        procedure chkConsentClick(Sender: TObject);
86        procedure cboUrgencyChange(Sender: TObject);
87        procedure cboSurgeryChange(Sender: TObject);
88        procedure calCollTimeChange(Sender: TObject);
89        procedure cboQuickClick(Sender: TObject);
90        procedure tQuantityEnter(Sender: TObject);
91        procedure btnUpdateCommentsClick(Sender: TObject);
92        procedure btnCancelCommentClick(Sender: TObject);
93        procedure cboSurgeryClick(Sender: TObject);
94        procedure cboReasonsEnter(Sender: TObject);
95        procedure cboReasonsExit(Sender: TObject);
96        procedure tQuantityClick(Sender: TObject);
97        procedure tQuantityChange(Sender: TObject);
98        procedure cboReasonsChange(Sender: TObject);
99        procedure cboModifiersChange(Sender: TObject);
100       procedure lvSelectionListClick(Sender: TObject);
101       procedure cboCollTimeChange(Sender: TObject);
102       procedure memDiagCommentChange(Sender: TObject);
103       procedure cboUrgencyExit(Sender: TObject);
104       procedure pnlBloodComponentsEnter(Sender: TObject);
105       procedure pnlDiagnosticTestsEnter(Sender: TObject);
106       procedure pnlDiagnosticTestsExit(Sender: TObject);
107       procedure pnlBloodComponentsExit(Sender: TObject);
108       procedure pnlBloodComponentsClick(Sender: TObject);
109       procedure pnlDiagnosticTestsClick(Sender: TObject);
110       procedure cboCollTypeClick(Sender: TObject);
111       procedure cboAvailTestEnter(Sender: TObject);
112       procedure cboCollTypeEnter(Sender: TObject);
113       procedure txtImmedCollEnter(Sender: TObject);
114       procedure calCollTimeEnter(Sender: TObject);
115       procedure cboCollTimeEnter(Sender: TObject);
116       procedure cboModifiersEnter(Sender: TObject);
117       procedure calWantTimeEnter(Sender: TObject);
118       procedure cboAvailCompEnter(Sender: TObject);
119       procedure FormShow(Sender: TObject);
120     protected
121       FCmtTypes: TStringList ;
122       procedure InitDialog; override;
123       function  ValidCollTime(UserEntry: string): string;
124       procedure GetAllCollSamples(AComboBox: TORComboBox);
125       procedure GetAllSpecimens(AComboBox: TORComboBox);
126       procedure SetupCollTimes(CollType: string);
127       procedure LoadCollType(AComboBox:TORComboBox);
128       function  ValidAdd: Boolean;
129       procedure ValidateAdd(var AnErrMsg: string);
130       procedure Validate(var AnErrMsg: string); override;
131       procedure ExtractMSBOS(OutList:TStrings; AList:TStrings);
132       procedure ExtractTests(OutList:TStrings; AList:TStrings);
133       procedure ExtractSurgeries(OutList:TStrings; AList:TStrings);
134       procedure ExtractUrgencies(OutList:TStrings; AList:TStrings);
135       procedure ExtractTNSOrders(OutList:TStrings; AList:TStrings);
136       procedure ExtractModifiers(OutList:TStrings; AList:TStrings);
137       procedure ExtractReasons(OutList:TStrings; AList:TStrings);
138       procedure ExtractSpecimens(OutList:TStrings; AList:TStrings);
139       procedure ExtractTypeScreen(OutList:TStrings; AList:TStrings);
140       procedure ExtractOther(OutList:TStrings; AList:TStrings);
141       procedure ExtractPatientInfo(OutList:TStrings; AList:TStrings);
142       procedure ExtractSpecimen(OutList:TStrings; AList:TStrings);
143       function  SpecimenNeeded(OutList:TStrings; AList:TStrings; CompID:integer): Boolean;
144       procedure LoadUrgencies(AComboBox:TORComboBox);
145       procedure LoadModifiers(AComboBox:TORComboBox);
146       procedure LoadReasons(AComboBox:TORComboBox);
147   
148     private
149       FLastCollType: string;
150       FLastCollTime: string;
151       FLastLabCollTime: string;
152       FLastLabID: string;
153       FLastItemID: string;
154       FEvtDelayLoc: integer;
155       FEvtDivision: integer;
156       FVbecLookup: string;
157       FQuickList:  Integer;
158       FQuickItems: TStringList;
159       FOrderAction: Integer;
160       procedure ReadServerVariables;
161       procedure SetOnQuickOrder;
162     public
163       procedure SetupDialog(OrderAction: Integer; const ID: string); override;
164       procedure LoadRequiredComment(CmtType: integer);
165       procedure DetermineCollectionDefaults(Responses: TResponses);
166       property  EvtDelayLoc: integer   read FEvtDelayLoc   write FEvtDelayLoc;
167       property  EvtDivision: integer   read FEvtDivision   write FEvtDivision;
168     end;
169   
170   type
171     TCollSamp = class(TObject)
172       CollSampID: Integer;                  { IEN of CollSamp }
173       CollSampName: string;                 { Name of CollSamp }
174       SpecimenID: Integer;                  { IEN of default specimen }
175       SpecimenName: string;                 { Name of the specimen }
176       TubeColor: string;                    { TubeColor (text) }
177       MinInterval: Integer;                 { Minimum days between orders }
178       MaxPerDay: Integer;                   { Maximum orders per day }
179       LabCanCollect: Boolean;               { True if lab can collect }
180       SampReqComment: string;               { Name of required comment }
181       WardComment: TStringList;             { CollSamp specific comment }
182     end;
183   
184     TLabTest = class(TObject)
185       TestID: Integer;                      { IEN of Lab Test }
186       TestName: string;                     { Name of Lab Test }
187       ItemID: Integer;                      { Orderable Item ID }
188       LabSubscript: string ;                { which section of Lab? }
189       CollSamp: Integer;                    { index into CollSampList }
190       Specimen: Integer;                    { IEN of specimen }
191       Urgency: Integer;                     { IEN of urgency }
192       Comment: TStringList;                 { text of comment }
193       TestReqComment: string;               { Name of required comment }
194       CurReqComment: string;                { name of required comment }
195       CurWardComment: TStringList;          { WP of Ward Comment }
196       UniqueCollSamp: Boolean;              { true if not prompt CollSamp }
197       CollSampList: TList;                  { collection sample objects }
198       CollSampCount: integer;               { count of original contents of CollSampList}
199       SpecimenList: TStringList;            { Strings: IEN^Specimen Name }
200       SpecListCount: integer;               { count of original contents of SpecimenList}
201       UrgencyList: TStringList;             { Strings: IEN^Urgency Name }
202       ForceUrgency: Boolean;                { true if not prompt Urgency }
203       SurgeryList: TStringList;             { Strings: Surgeries}
204       PatientInfo: TStringList;             { Text of Patient Information}
205       ResultsDisplay: TStringList;          { Text of Test Results}
206       QuickOrderResponses: TResponses;      { if created as a result of a quick order selection}
207       { functions & procedures }
208       constructor Create(const LabTestIEN: string; Responses: TResponses);
209       destructor Destroy; override ;
210       function  IndexOfCollSamp(CollSampIEN: Integer): Integer;
211       procedure FillCollSampList(LoadData: TStringList; DfltCollSamp: Integer);
212       procedure LoadAllSamples;
213       procedure SetCollSampDflts;
214       procedure ChangeCollSamp(CollSampIEN: Integer);
215       procedure ChangeSpecimen(const SpecimenIEN: string);
216       procedure ChangeComment(const CommentText: string);
217       function  LabCanCollect: Boolean;
218       procedure LoadCollSamp(AComboBox: TORComboBox);
219       procedure LoadSpecimen(AComboBox: TORComboBox);
220       procedure LoadUrgency(CollType: string; AComboBox:TORComboBox);
221       function  NameOfCollSamp: string;
222       function  NameOfSpecimen: string;
223       function  NameOfUrgency: string;
224       function  ObtainCollSamp: Boolean;
225       function  ObtainSpecimen: Boolean;
226       function  ObtainUrgency: Boolean;
227       function  ObtainComment: Boolean;
228   
229     end;
230   
231   const
232     CmtType: array[0..6] of string = ('ANTICOAGULATION','DOSE/DRAW TIMES','ORDER COMMENT',
233                                       'ORDER COMMENT MODIFIED','TDM (PEAK-TROUGH)',
234                                       'TRANSFUSION','URINE VOLUME');
235   var
236     frmODBBank: TfrmODBBank;
237   
238   implementation
239   
240   {$R *.dfm}
241   
242   uses rODBase, rODLab, uCore, rCore, fODLabOthCollSamp, fODLabOthSpec, fODLabImmedColl, fLabCollTimes,
243    rOrders, uODBase, fRptBox;
244   
245   var
246     uSelectedItems: TStringList;   //Selected Items in ListView- if TestYes =1 then test else component
247                                    //TestYes(1)^Test-Component(2)^Qty(3)^Modifier(4)^Specimen(5,6)^CollTime(7)^CollType(8)
248     uVBECList: TStringList;        //List of items from VBEC api
249     uTestsForResults: TStringList; //List of tests to show results
250     uUrgencyList: TStringList;     //List of Urgencies
251     uTNSOrders: TStringList;       //List of Current orders for Type & Screen
252     uModifierList: TStringList;    //List of Modifiers
253     uReasonsList: TStringList;     //List of Reasons for Request
254     uRaw: TStringList;             //Results Array
255     uTestSelected, uComponentSelected: Boolean;  //Used on Validate
256     uDfltUrgency: Integer;         //Default Urgency
257     uSelUrgency: String;          //Previously Selected Urgency - Used when components have been added for specific urgency
258     uSelSurgery: Integer;          //Selected Surgery for Blood order
259     uSpecimen, uGetTnS: Integer;            //Set to 1 if a specimen for test is already in lab... no need to collect
260     uDfltCollType, uReason: string;
261     ALabTest: TLabTest;
262     UserHasLRLABKey: boolean;
263     uChangingMSBOS: boolean;
264     LRFZX     : string;  //the default collection type  (LC,WC,SP,I)
265     LRFSAMP   : string;  //the default sample           (ptr)
266     LRFSPEC   : string;  //the default specimen         (ptr)
267     LRFDATE   : string;  //the default collection time  (NOW,NEXT,AM,PM,T...)
268     LRFURG    : string;  //the default urgency          (number)		TRY '2'
269     LRFSCH    : string;  //the default schedule?        (ONE TIME, QD, ...)
270     LRORDERMODE : Integer; //the mode being used to order (component or diagnostic test)
271   
272   const
273     TX_NO_TEST          = 'A Lab Test must be specified.'    ;
274     TX_NO_IMMED = 'Immediate collect is not available for this test/sample';
275     TX_NO_IMMED_CAP = 'Invalid Collection Type';
276   
277     TI_INFO = 0;    //Corresponds with pgeProduct TabIndex
278     TI_COMPONENT = 1;
279     TI_RESULTS = 2;
280   
281     TORDER_MODE_INFO = 0;
282     TORDER_MODE_DIAG = 1;
283     TORDER_MODE_COMP = 2;
284   
285   procedure TfrmODBBank.FormCreate(Sender: TObject);
286   var
287     i: integer;
288     AList, ATests: TStringList;
289     ListCount: Integer;
290     x: string;
291   begin
292     AutoSizeDisabled := True;
293     inherited;
294     AList := TStringList.Create;
295     ATests := TStringList.Create;
296     uSelectedItems := TStringList.Create;
297     uVBECList := TStringList.Create;
298     uTestsForResults := TStringList.Create;
299     uUrgencyList := TStringList.Create;
300     uTNSOrders := TStringList.Create;
301     uModifierList := TStringList.Create;
302     uReasonsList := TStringList.Create;
303     uRaw := TStringList.Create;
304     uSpecimen := 0;
305     uGetTnS := 0;
306     uReason := '';
307     lblTNS.Caption := '';
308     lblTNS.Visible := false;
309     pnlMessage.Visible := false;
310     uDfltUrgency := 9;
311     uSelUrgency := '';
312     uSelSurgery := 0;
313     uChangingMSBOS := false;
314     TabResults.Caption := 'Lab Results';
315     edtResults.Lines.Clear;
316     edtResults.Lines.Add('Lab results are ONLY available after selecting/adding a component on the Blood Bank Orders tab that has been designated for results retrieval.');
317     Responses.Clear;
318     try
319       LRFZX    := '';
320       LRFSAMP  := '';
321       LRFSPEC  := '';
322       LRFDATE  := '';
323       LRFURG   := '';
324       LRFSCH   := '';
325       LRORDERMODE := TORDER_MODE_INFO;
326       FLastColltime := '';
327       FLastLabCollTime := '';
328       FLastItemID := '';
329       uDfltCollType := '';
330       FillerID := 'LR';
331       FEvtDelayLoc := 0;
332       FEvtDivision := 0;
333       UserHasLRLABKey := User.HasKey('LRLAB');
334       AllowQuickOrder := True;
335       if GetDiagnosticPanelLocation then
336         begin
337           pnlDiagnosticTests.Left := 0;
338           pnlBloodComponents.Left := (pnlDiagnosticTests.Width + 10);
339           pnlDiagnosticTests.TabOrder := 0;
340           pnlBloodComponents.TabOrder := 1;
341         end
342       else
343         begin
344           pnlBloodComponents.Left := 0;
345           pnlDiagnosticTests.Left := (pnlBloodComponents.Width + 10);
346           pnlBloodComponents.TabOrder := 0;
347           pnlDiagnosticTests.TabOrder := 1;
348         end;
349       StatusText('Loading Dialog Definition');
350       FCmtTypes := TStringList.Create;
351       for i := 0 to 6 do FCmtTypes.Add(CmtType[i]) ;
352       Responses.Dialog := 'VBEC BLOOD BANK';        // loads formatting info
353       StatusText('Loading Default Values');
354       if Self.EvtID > 0 then
355       begin
356         EvtDelayLoc := StrToIntDef(GetEventLoc1(IntToStr(Self.EvtID)),0);
357         EvtDivision := StrToIntDef(GetEventDiv1(IntToStr(Self.EvtID)),0);
358         if EvtDelayLoc>0 then
359           FastAssign(ODForLab(EvtDelayLoc,EvtDivision), AList)
360         else
361           FastAssign(ODForLab(Encounter.Location,EvtDivision), AList);
362       end else
363         FastAssign(ODForLab(Encounter.Location), AList); // ODForLab returns TStrings with defaults
364       CtrlInits.LoadDefaults(AList);
365       InitDialog;
366       GroupBox1.Visible := True;
367       with CtrlInits do
368       begin
369         SetControl(cboCollType, 'Collection Types');
370         uDfltCollType := ExtractDefault(AList, 'Collection Types');
371         if uDfltCollType <> '' then
372           cboCollType.SelectByID(uDfltCollType)
373         else if OrderForInpatient then
374           cboCollType.SelectByID('LC')
375         else
376           cboCollType.SelectByID('SP');
377         //SetupCollTimes(cboCollType.ItemID);
378       end;
379       cboAvailTest.Clear;
380       aList.Clear;
381       GetDiagnosticTests(aList);            //Get Tests in right order
382       for i := 0 to aList.Count - 1 do
383         cboAvailTest.Items.Add(aList[i]);
384       cboAvailComp.Clear;
385       aList.Clear;
386       GetBloodComponents(aList);            //Get Components in right order
387       for i := 0 to aList.Count - 1 do
388         cboAvailComp.Items.Add(aList[i]);
389       uVBECList.Clear;
390       edtInfo.Clear;
391       cboSurgery.Clear;
392       GetPatientBBInfo(uVBECList, Patient.DFN, Encounter.Location);
393       aList.Clear;
394       ExtractPatientInfo(AList, uVBECList);
395       QuickCopy(AList, edtInfo);
396       AList.Clear;
397       ExtractSurgeries(AList, uVBECList);
398       for i := 0 to AList.Count - 1 do
399         cboSurgery.Items.Add(AList[i]);
400       AList.Clear;
401       ExtractUrgencies(uUrgencyList, uVBECList);
402       if not(self.EvtID > 0) then ExtractTNSOrders(uTNSOrders, uVBECList);
403       LoadUrgencies(cboUrgency);
404       ExtractModifiers(uModifierList, uVBECList);
405       ExtractReasons(uReasonsList, uVBECList);
406       LoadModifiers(cboModifiers);
407       LoadReasons(cboReasons);
408       pgeProduct.TabIndex := TI_INFO;
409       lvSelectionList.Column[0].Width := 240;
410       lvSelectionList.Column[1].Width := 30;
411       lvSelectionList.Column[2].Width := 100;
412       DisableComponentControls;
413       DisableDiagTestControls;
414       pnlDiagnosticTests.Caption := 'Diagnostic Tests';
415       pgeProduct.ActivePageIndex := TI_INFO;
416       StatusText('');
417       x := 'VBEC';
418       FQuickItems := TStringList.Create;
419       ListForQuickOrders(FQuickList, ListCount, x);
420       if ListCount > 0 then
421         begin
422           SubsetOfQuickOrders(FQuickItems, FQuickList, 0, 0);
423         end else
424         begin
425           ListCount := 1;
426           FQuickItems.Add('0^(No quick orders available)');
427         end;
428   
429       FastAssign(FQuickItems, cboQuick.Items);
430       if lvSelectionList.Items.Count > 0 then
431         begin
432           memOrder.Visible := true;
433           cmdAccept.Visible := true;
434         end;
435     finally
436       AList.Free;
437       ATests.Free;
438     end;
439   end;
440   
441   procedure TfrmODBBank.InitDialog;
442   begin
443     inherited;
444     Changing := True;
445     if ALabTest <> nil then
446       begin
447         ALabTest.Destroy;
448         ALabTest := nil;
449       end;
450     DisableCommentPanels;
451     cboAvailTest.SelectByID(FLastItemID);
452     cboAvailComp.SelectByID(FLastItemID);
453     cboAvailTest.ItemIndex := -1;
454     StatusText('');
455     Changing := False ;
456   end;
457   
458   procedure TfrmODBBank.SetupDialog(OrderAction: Integer; const ID: string);
459   var
460     AnInstance, CurAdd: Integer;
461     AResponse: TResponse;
462     i, j, k, aTNS, getTest, TestAdded, aMSBOSContinue: integer;
463     aStr, aTestYes, aName, aTypeScreen, aSpecimen, aSpecimenUID, aSpecimenReq, aModifier, sub, sub1, x, aTNSString, aUrgText: string;
464     ListItem: TListItem;
465     aList, cList: TStringList;
466     aTests: TStringList;
467     xLabTest: TLabTest;
468     aGotTNS : Boolean;
469   begin
470     inherited;
471     aList := TStringList.Create;
472     cList := TStringList.Create;
473     aTests:= TStringList.Create;
474     aGotTNS := false;
475     try
476     FOrderAction := OrderAction;
477     ReadServerVariables;
478     sub1 := '';
479     aTypeScreen := '';
480     aSpecimen := '';
481     aSpecimenUID := '';
482     aSpecimenReq := '';
483     aModifier := '';
484     if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses, ALabTest do
485       begin
486         pgeProduct.ActivePageIndex := TI_COMPONENT;
487         AnInstance := NextInstance('ORDERABLE', 0);
488         while AnInstance > 0 do
489           begin
490             AResponse := FindResponseByName('ORDERABLE', AnInstance);
491             if AResponse <> nil then
492               begin
493                 sub := GetSubtype(AResponse.EValue);
494                 if sub = 't' then
495                   begin
496                     SetControl(cboAvailTest,        'ORDERABLE', AnInstance);
497                     changing := true;
498                     cboAvailTestSelect(Self);
499                     changing := false;
500                   end
501                 else
502                   begin
503                     SetControl(cboAvailComp,        'ORDERABLE', AnInstance);
504                     ALabTest := TLabTest.Create(cboAvailComp.ItemID, Responses);
505                   end;
506                 if ALabTest = nil then Exit;  // Causes access violation
507                 if AnInstance = 1 then
508                   begin
509                     SetControl(cboReasons,         'REASON' , AnInstance);
510                     SetControl(calWantTime,        'DATETIME', AnInstance);
511                     SetControl(memDiagComment,     'COMMENT', AnInstance);
512                     SetControl(chkConsent,         'YN', AnInstance);
513                     //DetermineCollectionDefaults(Responses);
514                     SetControl(cboSurgery,         'MISC', AnInstance);
515                     SetControl(cboUrgency,         'URGENCY', AnInstance);
516                     if cboUrgency.ItemIEN = 0 then
517                       begin
518                         if StrToIntDef(LRFURG, 0) > 0 then
519                           cboUrgency.SelectByID(LRFURG)
520                         else if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
521                           cboUrgency.ItemIndex := 0;
522                       end;
523                     Urgency := cboUrgency.ItemIEN;
524                     if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
525                       begin
526                         cboUrgency.ItemIndex := 0;
527                         Urgency := cboUrgency.ItemIEN;
528                       end;
529                     i := 1 ;
530                     AResponse := Responses.FindResponseByName('COMMENT',i);
531                     while AResponse <> nil do
532                       begin
533                         Comment.Add(AResponse.EValue);
534                         Inc(i);
535                         AResponse := Responses.FindResponseByName('COMMENT',i);
536                       end ;
537                     cboUrgencyChange(self);
538                   end;
539                 if sub = 't' then with ALabTest do      //DIAGNOSTIC TEST
540                   begin
541                     Changing := True;
542                     DisableComponentControls;
543                     EnableDiagTestControls;
544                     LRORDERMODE := TORDER_MODE_DIAG;
545                     //DetermineCollectionDefaults(Responses);
546                     aList.Clear;
547                     aTestYes := '1';
548                     ExtractTypeScreen(aList, uVBECList);
549                     if aList.Count > 0 then aTypeScreen := aList[0];
550                     aList.Clear;
551                     if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
552                     if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
553                       else
554                         begin
555                           cboUrgency.ItemIndex := 2;
556                           for i := 0 to cboUrgency.Items.Count - 1 do
557                             begin
558                               aUrgText := cboUrgency.Items[i];
559                               if aUrgText = '9^ROUTINE' then    // Find urgency default of ROUTINE
560                                 begin
561                                   cboUrgency.ItemIndex := i;
562                                   break;
563                                 end;
564                             end;
565                           Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
566                           cboUrgencyChange(self);
567                         end;
568                     if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
569                     if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
570                     memOrder.Text := Responses.OrderText;
571                     Changing := False;
572                     if ObtainCollSamp then
573                       begin
574                         //For BloodBank orders, this condition should never occur
575                       end
576                     else
577                       begin
578                         with ALabTest do
579                           with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
580                             begin
581                               x := '' ;
582                               for i := 0 to WardComment.Count-1 do
583                               x := x + WardComment.strings[i]+#13#10 ;
584                               pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
585                               OrderMessage(x) ;
586                             end ;
587                       end;
588                   end;
589                 if sub = 'c' then with ALabTest do  //COMPONENT
590                   begin
591                     Changing := True;
592                     DisableDiagTestControls;
593                     EnableComponentControls;
594                     aTestYes := '0';
595                     LRORDERMODE := TORDER_MODE_COMP;
596                     SetControl(cboModifiers,       'MODIFIER', AnInstance);
597                     SetControl(tQuantity,          'QTY', AnInstance);
598                     uComponentSelected := true;
599                     aList.Clear;
600                     TestAdded := 0;
601                     getTest := 0;
602                     ExtractTests(aList, uVBECList);   //Get Results associated with ordered components
603                       for j := 0 to aList.Count - 1 do
604                         begin
605                           if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then
606                             begin
607                               if uTestsForResults.Count < 1 then getTest := 1;
608                               for k := 0 to uTestsForResults.Count - 1 do
609                                 begin
610                                   if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then
611                                     begin
612                                       getTest := 0;
613                                       break;
614                                     end
615                                   else getTest := 1;
616                                 end;
617                               if getTest = 1 then
618                                 begin
619                                   uTestsForResults.Add(piece(aList[j],'^',3));
620                                   TestAdded := 1;
621                                 end;
622                             end;
623                         end;
624                       if TestAdded = 1 then
625                         begin
626                           aTests.Clear;
627                           GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults);
628                           if aTests.Count > 0 then
629                             begin
630                               edtResults.Clear;
631                               QuickCopy(ATests,edtResults);
632                               TabResults.Caption := 'Lab Results Available';
633                               uRaw.Clear;
634                               GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
635                             end;
636                         end;
637                       CurAdd := 1;
638                       if uRaw.Count > 0 then
639                       for j := 0 to uRaw.Count - 1 do
640                         begin
641                           if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
642                           Inc(CurAdd);
643                         end;
644                     for i := lvSelectionList.Items.Count - 1 downto 0 do
645                       begin
646                         if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
647                           begin
648                             aGotTNS := true;
649                             break;
650                           end;
651                       end;
652                     if (uTNSOrders.Count < 1) and (aGotTNS = false) and (SpecimenNeeded(aList, uVBECList, aLabTest.ItemID)) then  //check to see if type and screen is needed CQ 17349
653                       begin
654                         uGetTnS := 1;
655                       end;
656                     if aList.Count > 0 then
657                       begin
658                         aSpecimen := piece(aList[0], '^',1);
659                         aSpecimenUID := piece(aList[0], '^',2);
660                       end;
661                     aList.Clear;
662                     ExtractSpecimens(aList, uVBECList);    //Get specimen values to pass back to Server
663                     for i := 0 to aList.Count - 1 do
664                       begin
665                         if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then
666                           begin
667                             aSpecimenReq := piece(aList[i],'^',2);
668                             if (SpecimenNeeded(aList, uVBECList, aLabTest.ItemID)) then
669                               aSpecimenUID := '';
670                             break;
671                           end;
672                       end;
673                     with lvSelectionList do
674                       begin
675                         ListItem := Items.Add;
676                         ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2);
677                         ListItem.SubItems.Add(tQuantity.Text);
678                         if length(cboModifiers.ItemID) > 0 then
679                           begin
680                             ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
681                             ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
682                           end
683                           else
684                             begin
685                               ListItem.SubItems.Add('');
686                               ListItem.SubItems.Add('');
687                             end;
688                         ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
689                       end;
690                     aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimenReq + '^' + aSpecimen + '^' + aSpecimenUID + '^' + IntToStr(aLabTest.ItemID);
691                     uSelectedItems.Add(aStr);
692                     memOrder.Text := Responses.OrderText;
693                     Changing := False;
694                     if (Length(cboSurgery.Text) > 0) then
695                       begin
696                         for i := 0 to cboSurgery.Items.Count - 1 do
697                           if uppercase(cboSurgery.Text) = uppercase(piece(cboSurgery.Items[i],'^',2)) then
698                             begin
699                               cboSurgery.ItemIndex := i;
700                               Break;
701                             end;
702                         cboSurgeryChange(self);
703                       end;
704                   end;
705               end;
706             StatusText('');
707             AnInstance := NextInstance('ORDERABLE', AnInstance);
708           end;  //while AnInstance - ORDERABLE
709         DisableComponentControls;
710         DisableDiagTestControls;
711       end;
712       cList.Clear;
713       if (Length(cboSurgery.ItemID) > 0) then
714         begin
715           for j := 0 to uSelectedItems.Count - 1 do
716             begin
717               xLabTest := TLabTest.Create(piece(uSelectedItems[j],'^',2), Responses);
718               if (piece(uSelectedItems[j],'^',1) = '0') and (not(piece(uSelectedItems[j],'^',3)='')) and (StrToInt(piece(uSelectedItems[j],'^',3)) > 0) and (piece(cboSurgery.Items[cboSurgery.ItemIndex],'^',3) = '1') then
719                 begin
720                   cList.Add(xLabTest.TestName + '^' + piece(uSelectedItems[j],'^',3));
721                 end;
722               xLabTest.Free;
723             end;
724         end;
725       if (uChangingMSBOS = false) and (cList.Count > 0) then
726         begin
727           lblNoBloodReq.Visible := true;
728           with Application do
729             begin
730               NormalizeTopMosts;
731               aMSBOSContinue :=
732                 MessageBox(PChar('No blood is required for the surgical procedure: ' + cboSurgery.text +
733                  '.' + CRLF +
734                  'If you still need to order any components, please enter a justification in the Comment box.'
735                   + CRLF + CRLF + 'Do you want me to remove ALL the component orders you''ve just entered? '),
736                  PChar('No Blood Required'),MB_YESNO);
737               RestoreTopMosts;
738             end;
739           if aMSBOSContinue = 6 then
740             begin
741               tQuantity.Text := '';
742               for j := uSelectedItems.Count - 1 downto 0 do
743                 begin
744                   if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '0') then
745                     begin
746                       lvSelectionList.Items[j].Delete;
747                       uSelectedItems.Delete(j);
748                       Responses.Update('ORDERABLE', (j+1) ,'', '');
749                       Responses.Update('MODIFIER', (j+1), '', '');
750                       Responses.Update('QTY', (j+1), '', '');
751                     end;
752                 end;
753               cboAvailComp.Text := '';
754               cboAvailComp.ItemIndex := -1;
755               cboModifiers.Text := '';
756               cboModifiers.ItemIndex := -1;
757               lblNoBloodReq.Visible := false;
758               //if fODBBank. Active then cboAvailTest.SetFocus;
759               lblTNS.Caption := '';
760               lblTNS.Visible := false;
761               DisableComponentControls;
762             end;
763         end;
764         for i := 0 to lvSelectionList.Items.Count - 1 do
765           begin
766             if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
767               begin
768                 uGetTnS := 0;
769                 aGotTNS := true;
770                 uDfltUrgency := cboUrgency.ItemID;
771                 lblTNS.Caption := '';
772                 lblTNS.Visible := false;
773                 memMessage.Text := '';
774                 pnlMessage.Visible := false;
775                 pnlDiagnosticTests.Caption := 'Diagnostic Tests';
776                 if uTNSOrders.Count > 0 then
777                   begin
778                     for j := 0 to uTNSOrders.Count - 1 do
779                       aTNSString := aTNSString + CRLF + uTNSOrders[j];
780                     with Application do
781                       begin
782                         NormalizeTopMosts;
783                         aTNS :=
784                           MessageBox(PChar(aTNSString + CRLF + CRLF +
785                              'Do you wish to cancel this request for Type & Screen?'),
786                              PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'),
787                              MB_YESNO);
788                         RestoreTopMosts;
789                         if aTNS = 6 then
790                           begin
791                             lvSelectionList.ItemIndex := i;
792                             lvSelectionListClick(self);
793                             btnRemoveClick(self);
794                             break;
795                           end;
796                       end;
797                   end;
798                 break;
799               end;
800           end;
801         if uSelectedItems.Count < 1 then uGetTNS := 0;
802   
803         for i := uSelectedItems.Count - 1 downto 0 do
804           begin
805             if (aGotTNS = false) and not(piece(uSelectedItems[i],'^',1) = '1') and (uTNSOrders.Count < 1) and (piece(uSelectedItems[i],'^',5) = '1') then //CQ 17349
806               begin
807                 uGetTnS := 1;
808                 break;
809               end;
810           end;
811   
812       CurAdd := 1;
813       for i := 0 to uSelectedItems.Count - 1 do
814         begin
815           aName := lvSelectionList.Items[i].Caption;
816           x := uSelectedItems[i];
817           if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
818             begin
819               if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
820             end
821           else
822             begin
823               if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
824               if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
825               if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), piece(x,'^',4));
826               if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
827               if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
828               if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
829               if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
830                 else
831                   begin
832                     cboUrgency.ItemIndex := 2;
833                     for j := 0 to cboUrgency.Items.Count - 1 do
834                       begin
835                         aUrgText := cboUrgency.Items[j];
836                         if aUrgText = '9^ROUTINE' then    // Find urgency default of ROUTINE
837                           begin
838                             cboUrgency.ItemIndex := j;
839                             break;
840                           end;
841                       end;
842                     Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
843                     cboUrgencyChange(self);
844                   end;
845             end;
846           Inc(CurAdd);
847         end;
848       if uGetTnS = 1 then
849         begin
850           lblTNS.Caption := 'TYPE + SCREEN must be added to order';
851           lblTNS.Visible := true;
852           memMessage.Text := 'TYPE + SCREEN must be added to order';
853           pnlMessage.Visible := true;
854           pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
855         end
856         else pnlDiagnosticTests.Caption := 'Diagnostic Tests';
857     finally
858       aList.Free;
859       cList.Free;
860       aTests.Free;
861     end;
862     if lvSelectionList.Items.Count > 0 then
863       begin
864         pnlSelectedTests.Visible := True;
865         cmdAccept.Visible := True;
866         memOrder.Visible := True;
867         GroupBox1.Visible := False;
868         lvSelectionList.Items[0].Selected := true;
869         lvSelectionListClick(self);
870       end;
871   end;
872   
873   procedure TfrmODBBank.SetOnQuickOrder;
874     var
875     AnInstance: Integer;
876     AResponse: TResponse;
877     i: integer;
878     x,sub,sub1,aTNSString: string;
879     aList, cList: TStringList;
880     aGotIt, aGotTNS: boolean;
881     aTests: TStringList;
882     ListItem: TListItem;
883     xLabTest: TLabTest;
884     aName, aMsg, aStr, aModifier, aReason, aSurgery, aCollTime, aTestYes, aSpecimen, aSpecimenUID, aSpecimenReq, aTypeScreen, aUrgText: String;
885     CurAdd, j, k, getTest, TestAdded, aMSBOS, aMSBOSContinue, aTNS: Integer;
886   begin
887     inherited;
888     aList := TStringList.Create;
889     cList := TStringList.Create;
890     aTests := TStringList.Create;
891     pgeProduct.ActivePageIndex := TI_COMPONENT;
892     try
893       aModifier := '';
894       aReason := '';
895       aSurgery := '';
896       aCollTime := '';
897       aTestYes := '0';
898       aTypeScreen := '';
899       aSpecimen := '';
900       aSpecimenUID := '';
901       aSpecimenReq := '';
902       sub1 := '';
903       aGotTNS := false;
904       ExtractTypeScreen(aList, uVBECList);
905       if aList.Count > 0 then aTypeScreen := aList[0];
906       aList.Clear;
907       ExtractSpecimen(aList, uVBECList);
908       if aList.Count > 0 then
909         begin
910           aSpecimen := piece(aList[0], '^',1);
911           aSpecimenUID := piece(aList[0], '^',2);
912         end;
913       with Responses, ALabTest do
914         begin
915           Changing := True;
916           aGotIt := False;
917           FLastItemID := cboQuick.ItemID;
918           QuickOrder := ExtractInteger(cboQuick.ItemID);
919           with Responses do
920             begin
921               StatusText('Initializing Quick Order');
922               AnInstance := NextInstance('ORDERABLE', 0);
923               while AnInstance > 0 do
924                 begin
925                   AResponse := FindResponseByName('ORDERABLE', AnInstance);
926                   sub := GetSubtype(AResponse.EValue);
927                   if sub = 't' then
928                     begin
929                       SetControl(cboAvailTest,        'ORDERABLE', AnInstance);
930                       ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses);
931                     end
932                   else
933                     begin
934                       SetControl(cboAvailComp,        'ORDERABLE', AnInstance);
935                       ALabTest := TLabTest.Create(cboAvailComp.ItemID, Responses);
936                     end;
937                   for i := 0 to aList.Count - 1 do
938                     if aList[i] = ALabTest.TestName then
939                       begin
940                         aGotIt := true;
941                         break;
942                       end;
943                   if aGotIt = true then
944                     begin
945                       aGotIt := false;
946                       AnInstance := NextInstance('ORDERABLE', AnInstance);
947                       Continue;
948                     end
949                     else
950                       begin
951                         aList.Add(ALabTest.TestName);
952                       end;
953                   if AResponse <> nil then
954                     sub1 := GetSubtype(AResponse.EValue);
955                   if AnInstance = 1 then
956                     begin
957                       SetControl(cboReasons,         'REASON', AnInstance);
958                       SetControl(calWantTime,        'DATETIME', AnInstance);
959                       SetControl(memDiagComment,     'COMMENT', AnInstance);
960                       SetControl(chkConsent,         'YN', AnInstance);
961                       //DetermineCollectionDefaults(Responses);
962                       SetControl(cboUrgency,         'URGENCY', AnInstance);
963                       if cboUrgency.ItemIEN = 0 then
964                         begin
965                           if StrToIntDef(LRFURG, 0) > 0 then
966                             cboUrgency.SelectByID(LRFURG)
967                           else if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
968                             cboUrgency.ItemIndex := 0;
969                         end;
970                       SetControl(cboSurgery,         'MISC', AnInstance);
971                       if Length(cboSurgery.Text) > 0 then
972                         begin
973                           for i := 0 to cboSurgery.Items.Count - 1 do
974                             if uppercase(cboSurgery.Text) = uppercase(piece(cboSurgery.Items[i],'^',2)) then
975                               begin
976                                 cboSurgery.ItemIndex := i;
977                                 Break;
978                               end;
979                           cboSurgeryChange(self);
980                         end;
981                       if not(ALabTest = nil) then
982                         begin
983                           i := 1 ;
984                           AResponse := Responses.FindResponseByName('COMMENT',i);
985                           while AResponse <> nil do
986                             begin
987                               Comment.Add(AResponse.EValue);
988                               Inc(i);
989                               AResponse := Responses.FindResponseByName('COMMENT',i);
990                             end ;
991                         end;
992                     end;
993                   if sub1 = 'c' then
994                     begin
995                       DisableDiagTestControls;
996                       EnableComponentControls;
997                       LRORDERMODE := TORDER_MODE_COMP;
998                       SetControl(cboAvailComp,       'ORDERABLE', AnInstance);
999                       SetControl(cboModifiers,       'MODIFIER', AnInstance);
1000                      SetControl(tQuantity,          'QTY', AnInstance);
1001                      aList.Clear;
1002                      TestAdded := 0;
1003                      getTest := 0;
1004                      ExtractTests(aList, uVBECList);   //Get Results associated with ordered components
1005                        for j := 0 to aList.Count - 1 do
1006                          begin
1007                            if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then
1008                              begin
1009                                if uTestsForResults.Count < 1 then getTest := 1;
1010                                for k := 0 to uTestsForResults.Count - 1 do
1011                                  begin
1012                                    if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then
1013                                      begin
1014                                        getTest := 0;
1015                                        break;
1016                                      end
1017                                    else getTest := 1;
1018                                  end;
1019                                if getTest = 1 then
1020                                  begin
1021                                    uTestsForResults.Add(piece(aList[j],'^',3));
1022                                    TestAdded := 1;
1023                                  end;
1024                              end;
1025                          end;
1026                        if TestAdded = 1 then
1027                          begin
1028                            aTests.Clear;
1029                            GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults);
1030                            if aTests.Count > 0 then
1031                              begin
1032                                edtResults.Clear;
1033                                QuickCopy(ATests,edtResults);
1034                                TabResults.Caption := 'Lab Results Available';
1035                                uRaw.Clear;
1036                                GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
1037                              end;
1038                          end;
1039                        CurAdd := 1;
1040                        if uRaw.Count > 0 then
1041                        for j := 0 to uRaw.Count - 1 do
1042                          begin
1043                            if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
1044                            Inc(CurAdd);
1045                          end;
1046                      aSpecimen := '';
1047                      aSpecimenUID := '';
1048                      aSpecimenReq := '';
1049                      aTestYes := '0';
1050                      aReason := '';
1051                      aSurgery := '';
1052                      aCollTime := '';
1053                      ExtractSpecimen(aList, uVBECList);
1054                      if aList.Count > 0 then
1055                        begin
1056                          aSpecimen := piece(aList[0], '^', 1);
1057                          aSpecimenUID := piece(aList[0], '^', 2);
1058                        end;
1059                      if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
1060                      if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex];
1061                      if length(cboSurgery.ItemID) > 0 then aSurgery := cboSurgery.Items[cboSurgery.ItemIndex];
1062                      if Length(cboSurgery.ItemID) > 0 then
1063                        begin
1064                          aList.Clear;
1065                          ExtractMSBOS(aList, uVBECList);    //Get maximum units for selected Surgey
1066                          for i := 0 to aList.Count - 1 do
1067                            begin
1068                              if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
1069                               and (uppercase((piece(aList[i],'^',3))) = uppercase(cboSurgery.Text)) then
1070                                begin
1071                                  aMSBOS := StrToInt(piece(aList[i],'^',4));
1072                                  if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
1073                                    begin
1074                                      with Application do
1075                                      begin
1076                                        NormalizeTopMosts;
1077                                        aMSBOSContinue :=
1078                                          MessageBox(PChar('The number of units ordered (' + tQuantity.Text +
1079                                             ') for ' + aLabTest.TestName + ' Exceeds the maximum number recommended ('
1080                                             + IntToStr(aMSBOS) +
1081                                             ') for the ' + cboSurgery.text +
1082                                             ' surgical procedure.' + CRLF +
1083                                             'If you need to order more than the maximum number of units, please enter a justification in the Comment box.'
1084                                              + CRLF + CRLF + 'Edit the Blood component Quantity?'),
1085                                             PChar('Maximum Number of Units Exceeded'),
1086                                             MB_YESNO);
1087                                        RestoreTopMosts;
1088                                      end;
1089                                      if aMSBOSContinue = 6 then
1090                                        begin
1091                                          ShowMsg(cboAvailComp.Text + ' has NOT been added to this request.');
1092                                          lvSelectionList.Clear;
1093                                          uSelectedItems.Clear;
1094                                          uTestsForResults.Clear;
1095                                          uRaw.Clear;
1096                                          uGetTnS := 0;
1097                                          lblTNS.Caption := '';
1098                                          lblTNS.Visible := false;
1099                                          memMessage.Text := '';
1100                                          pnlMessage.Visible := false;
1101                                          FLastItemID := '';
1102                                          InitDialog;
1103                                          cboModifiers.ItemIndex := -1;
1104                                          cboAvailTest.ItemIndex := -1;
1105                                          cboAvailComp.ItemIndex := -1;
1106                                          cboSurgery.ItemIndex := -1;
1107                                          cboUrgency.ItemIndex := -1;
1108                                          cboReasons.ItemIndex := -1;
1109                                          cboCollType.ItemIndex := -1;
1110                                          cboCollTime.ItemIndex := -1;
1111                                          cboQuick.ItemIndex := -1;
1112                                          calWantTime.Text := '';
1113                                          memDiagComment.Text := '';
1114                                          GroupBox1.Visible := true;
1115                                          tQuantity.Text := '';
1116                                          FLastCollType := '';
1117                                          FLastCollTime := '';
1118                                          FLastLabCollTime := '';
1119                                          txtImmedColl.Text := '';
1120                                          calCollTime.text := '';
1121                                          exit;
1122                                        end;
1123                                    end;
1124                                end;
1125                            end;
1126                        end;
1127                      for i := lvSelectionList.Items.Count - 1 downto 0 do
1128                        begin
1129                          if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
1130                            begin
1131                              aGotTNS := true;
1132                              break;
1133                            end;
1134                        end;
1135                      if (uTNSOrders.Count < 1) and (aGotTNS = false) and (SpecimenNeeded(aList, uVBECList, aLabTest.ItemID)) then  //check to see if type and screen is needed CQ 17349
1136                        begin
1137                          uGetTnS := 1;
1138                        end;
1139                      aList.Clear;
1140                      ExtractSpecimens(aList, uVBECList);    //Get specimen values to pass back to Server
1141                      for i := 0 to aList.Count - 1 do
1142                        begin
1143                          if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then
1144                            begin
1145                              aSpecimenReq := piece(aList[i],'^',2);
1146                              if (SpecimenNeeded(aList, uVBECList, aLabTest.ItemID)) then
1147                                aSpecimenUID := '';
1148                              break;
1149                            end;
1150                        end;
1151                      uComponentSelected := true;
1152                      with lvSelectionList do
1153                        begin
1154                          ListItem := Items.Add;
1155                          ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2);
1156                          ListItem.SubItems.Add(tQuantity.Text);
1157                          if length(cboModifiers.ItemID) > 0 then
1158                            begin
1159                              ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
1160                              ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
1161                            end
1162                            else
1163                              begin
1164                                ListItem.SubItems.Add('');
1165                                ListItem.SubItems.Add('');
1166                              end;
1167                          ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
1168                        end;
1169                      CurAdd := 1;
1170                      aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimenReq + '^' + aSpecimen + '^' + aSpecimenUID + '^' + IntToStr(aLabTest.ItemID);
1171                      uSelectedItems.Add(aStr);
1172                      for i := 0 to uSelectedItems.Count - 1 do
1173                        begin
1174                          aName := lvSelectionList.Items[i].Caption;
1175                          x := uSelectedItems[i];
1176                          if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
1177                            begin
1178                              if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
1179                            end
1180                          else
1181                            begin
1182                              if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
1183                              if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
1184                              if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), aModifier);
1185                              if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
1186                              if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
1187                            end;
1188                          Inc(CurAdd);
1189                        end;
1190                      memOrder.Text := Responses.OrderText;
1191                      GroupBox1.Visible := False;
1192                    aMsg := '';
1193                    LRORDERMODE := TORDER_MODE_INFO;
1194                    if lvSelectionList.Items.Count > 0 then
1195                      begin
1196                        pnlSelectedTests.Visible := True;
1197                        cmdAccept.Visible := True;
1198                        memOrder.Visible := True;
1199                        GroupBox1.Visible := False;
1200                      end;
1201                    end
1202                    else
1203                      begin
1204                        if sub1 = 't' then
1205                        begin
1206                          DisableComponentControls;
1207                          EnableDiagTestControls;
1208                          LRORDERMODE := TORDER_MODE_DIAG;
1209                          aTestYes := '1';
1210                          SetControl(cboAvailTest,       'ORDERABLE', AnInstance);
1211                          //DetermineCollectionDefaults(Responses); //cboCollType = COLLECT , calCollTime = START
1212                          i := 1 ;
1213                          AResponse := Responses.FindResponseByName('COMMENT',i);
1214                          while AResponse <> nil do
1215                            begin
1216                              Comment.Add(AResponse.EValue);
1217                              Inc(i);
1218                              AResponse := Responses.FindResponseByName('COMMENT',i);
1219                            end ;
1220                          if ObtainCollSamp then
1221                            begin
1222                            //For BloodBank orders, this condition should never occur
1223                            end
1224                          else
1225                            begin
1226                              with ALabTest do
1227                                with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
1228                                  begin
1229                                    x := '' ;
1230                                    for i := 0 to WardComment.Count-1 do
1231                                    x := x + WardComment.strings[i]+#13#10 ;
1232                                    pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
1233                                    OrderMessage(x) ;
1234                                  end ;
1235                            end;
1236                          if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
1237                          if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
1238                            else
1239                              begin
1240                                cboUrgency.ItemIndex := 2;
1241                                for i := 0 to cboUrgency.Items.Count - 1 do
1242                                  begin
1243                                    aUrgText := cboUrgency.Items[i];
1244                                    if aUrgText = '9^ROUTINE' then    // Find urgency default of ROUTINE
1245                                      begin
1246                                        cboUrgency.ItemIndex := i;
1247                                        break;
1248                                      end;
1249                                  end;
1250                                Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
1251                                cboUrgencyChange(self);
1252                              end;
1253                          if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
1254                          if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
1255                          uTestSelected := true;
1256                          with lvSelectionList do
1257                            begin
1258                              ListItem := Items.Add;
1259                              ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2);
1260                              ListItem.SubItems.Add('');
1261                              ListItem.SubItems.Add('');
1262                              ListItem.SubItems.Add('');
1263                              ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1));
1264                            end;
1265                          CurAdd := 1;
1266                          aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimenReq + '^' + aSpecimen + '^' + aSpecimenUID + '^' + IntToStr(aLabTest.ItemID);
1267                          uSelectedItems.Add(aStr);
1268                          for i := 0 to uSelectedItems.Count - 1 do
1269                            begin
1270                              aName := lvSelectionList.Items[i].Caption;
1271                              x := uSelectedItems[i];
1272                              if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
1273                                begin
1274                                  if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
1275                                end;
1276                              Inc(CurAdd);
1277                            end;
1278                          memOrder.Text := Responses.OrderText;
1279                        if lvSelectionList.Items.Count > 0 then
1280                          begin
1281                            pnlSelectedTests.Visible := True;
1282                            cmdAccept.Visible := True;
1283                            memOrder.Visible := True;
1284                            GroupBox1.Visible := False;
1285                          end;
1286                        end;
1287                      end;
1288                    AnInstance := NextInstance('ORDERABLE', AnInstance);
1289                end;
1290                //Quick Order
1291            end;
1292          cList.Clear;
1293          if (Length(cboSurgery.ItemID) > 0) then
1294            begin
1295              for j := 0 to uSelectedItems.Count - 1 do
1296                begin
1297                  xLabTest := TLabTest.Create(piece(uSelectedItems[j],'^',2), Responses);
1298                  if (piece(uSelectedItems[j],'^',1) = '0') and (not(piece(uSelectedItems[j],'^',3)='')) and (StrToInt(piece(uSelectedItems[j],'^',3)) > 0) and (piece(cboSurgery.Items[cboSurgery.ItemIndex],'^',3) = '1') then
1299                    begin
1300                      cList.Add(xLabTest.TestName + '^' + piece(uSelectedItems[j],'^',3));
1301                    end;
1302                  xLabTest.Free;
1303                end;
1304            end;
1305          if (uChangingMSBOS = false) and (cList.Count > 0) then
1306            begin
1307              lblNoBloodReq.Visible := true;
1308              with Application do
1309                begin
1310                  NormalizeTopMosts;
1311                  aMSBOSContinue :=
1312                    MessageBox(PChar('No blood is required for the surgical procedure: ' + cboSurgery.text +
1313                     '.' + CRLF +
1314                     'If you still need to order any components, please enter a justification in the Comment box.'
1315                      + CRLF + CRLF + 'Do you want me to remove ALL the component orders you''ve just entered? '),
1316                     PChar('No Blood Required'),MB_YESNO);
1317                  RestoreTopMosts;
1318                end;
1319              if aMSBOSContinue = 6 then
1320                begin
1321                  tQuantity.Text := '';
1322                  for j := uSelectedItems.Count - 1 downto 0 do
1323                    begin
1324                      if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '0') then
1325                        begin
1326                          lvSelectionList.Items[j].Delete;
1327                          uSelectedItems.Delete(j);
1328                          Responses.Update('ORDERABLE', (j+1) ,'', '');
1329                          Responses.Update('MODIFIER', (j+1), '', '');
1330                          Responses.Update('QTY', (j+1), '', '');
1331                        end;
1332                    end;
1333                  cboAvailComp.Text := '';
1334                  cboAvailComp.ItemIndex := -1;
1335                  cboModifiers.Text := '';
1336                  cboModifiers.ItemIndex := -1;
1337                  lblNoBloodReq.Visible := false;
1338                  //if fODBBank. Active then cboAvailTest.SetFocus;
1339                  lblTNS.Caption := '';
1340                  lblTNS.Visible := false;
1341                  DisableComponentControls;
1342                end;
1343            end;
1344          for i := 0 to lvSelectionList.Items.Count - 1 do
1345            begin
1346              if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
1347                begin
1348                  uGetTnS := 0;
1349                  uDfltUrgency := cboUrgency.ItemID;
1350                  lblTNS.Caption := '';
1351                  lblTNS.Visible := false;
1352                  memMessage.Text := '';
1353                  pnlMessage.Visible := false;
1354                  pnlDiagnosticTests.Caption := 'Diagnostic Tests';
1355                  if uTNSOrders.Count > 0 then
1356                    begin
1357                      for j := 0 to uTNSOrders.Count - 1 do
1358                        aTNSString := aTNSString + CRLF + uTNSOrders[j];
1359                      with Application do
1360                        begin
1361                          NormalizeTopMosts;
1362                          aTNS :=
1363                            MessageBox(PChar(aTNSString + CRLF + CRLF +
1364                               'Do you wish to cancel this request for Type & Screen?'),
1365                               PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'),
1366                               MB_YESNO);
1367                          RestoreTopMosts;
1368                          if aTNS = 6 then
1369                            begin
1370                              lvSelectionList.ItemIndex := i;
1371                              lvSelectionListClick(self);
1372                              btnRemoveClick(self);
1373                              break;
1374                            end;
1375                        end;
1376                    end;
1377                  break;
1378                end;
1379            end;
1380          if uGetTnS = 1 then
1381            begin
1382              lblTNS.Caption := 'TYPE + SCREEN must be added to order';
1383              lblTNS.Visible := true;
1384              memMessage.Text := 'TYPE + SCREEN must be added to order';
1385              pnlMessage.Visible := true;
1386              pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
1387            end
1388            else pnlDiagnosticTests.Caption := 'Diagnostic Tests';
1389          if ALabTest <> nil then
1390            begin
1391              if ObtainCollSamp then
1392                begin
1393                 //For BloodBank orders, this condition should never occur
1394                end
1395              else
1396                begin
1397                  with ALabTest do
1398                    with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
1399                      begin
1400                        x := '' ;
1401                        for i := 0 to WardComment.Count-1 do
1402                        x := x + WardComment.strings[i]+#13#10 ;
1403                        pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
1404                        OrderMessage(x) ;
1405                      end ;
1406                end;
1407              with ALabTest do
1408                begin
1409                  if ObtainComment then
1410                    LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))
1411                  else
1412                    DisableCommentPanels;
1413                  x := '' ;
1414                  for i := 0 to CurWardComment.Count-1 do
1415                    x := x + CurWardComment.strings[i]+#13#10 ;
1416                  i :=  IndexOfCollSamp(CollSamp);
1417                  if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
1418                    for i := 0 to WardComment.Count-1 do
1419                      x := x + WardComment.strings[i]+#13#10 ;
1420                  pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
1421                  OrderMessage(x) ;
1422                end;
1423              GroupBox1.Visible := False;
1424            end;
1425          StatusText('');
1426          Changing := False;
1427        end;
1428    finally                      //**SubTest
1429      alist.Free;
1430      cList.Free;
1431      aTests.Free;
1432    end;
1433  end;
1434  
1435  constructor TLabTest.Create(const LabTestIEN: string; Responses: TResponses);
1436  var
1437    LoadData, OneSamp: TStringList;
1438    DfltCollSamp: Integer;
1439    x: string;
1440    tmpResp: TResponse;
1441  begin
1442    LoadData := TStringList.Create;
1443    try
1444      LoadLabTestData(LoadData, LabTestIEN) ;
1445      with LoadData do
1446      begin
1447        QuickOrderResponses := Responses;
1448        TestID := StrToInt(LabTestIEN);
1449        TestName := Piece(ExtractDefault(LoadData, 'Test Name'),U,1);
1450        ItemID := StrToInt(Piece(ExtractDefault(LoadData, 'Item ID'),U,1));
1451        LabSubscript := Piece(ExtractDefault(LoadData, 'Item ID'),U,2);
1452        TestReqComment := ExtractDefault(LoadData, 'ReqCom');
1453        UniqueCollSamp := false;
1454        if Length(ExtractDefault(LoadData, 'Unique CollSamp')) > 0 then UniqueCollSamp := True;
1455        x := ExtractDefault(LoadData, 'Unique CollSamp');
1456        if Length(x) = 0 then x := ExtractDefault(LoadData, 'Lab CollSamp');
1457        if Length(x) = 0 then x := ExtractDefault(LoadData, 'Default CollSamp');
1458        if Length(x) = 0 then x := '-1';
1459        DfltCollSamp := StrToInt(x);
1460        SpecimenList := TStringList.Create;
1461        ExtractItems(SpecimenList, LoadData, 'Specimens');
1462        if LRFSPEC <> '' then SpecimenList.Add(GetOneSpecimen(StrToInt(LRFSPEC)));
1463        UrgencyList := TStringList.Create;
1464        if Length(ExtractDefault(LoadData, 'Default Urgency')) > 0 then  { forced urgency }
1465          begin
1466            ForceUrgency := True;
1467            UrgencyList.Add(ExtractDefault(LoadData, 'Default Urgency'));
1468            Urgency := StrToInt(Piece(ExtractDefault(LoadData, 'Default Urgency'), '^', 1));
1469            uDfltUrgency := Urgency;
1470          end
1471        else
1472          begin                 { list of urgencies }
1473            ExtractItems(UrgencyList, LoadData, 'Urgencies');
1474            if StrToIntDef(LRFURG, 0) > 0 then
1475              Urgency := StrToInt(LRFURG)
1476            else
1477              Urgency := uDfltUrgency;
1478          end;
1479        Comment := TStringList.Create ;
1480        CurWardComment := TStringList.Create;
1481        ExtractText(CurWardComment, LoadData, 'GenWardInstructions');
1482        CollSamp := 0;
1483        CollSampList := TList.Create;
1484        FillCollSampList(LoadData, DfltCollSamp);
1485        with QuickOrderResponses do tmpResp := FindResponseByName('SAMPLE'  ,1);
1486        if (LRFSAMP <> '') and (IndexOfCollSamp(StrToInt(LRFSAMP)) < 0) and
1487           (not UniqueCollSamp) and (tmpResp = nil) then
1488          begin
1489            OneSamp := TStringList.Create;
1490            try
1491              FastAssign(GetOneCollSamp(StrToInt(LRFSAMP)), OneSamp);
1492              FillCollSampList(OneSamp, CollSampList.Count);
1493            finally
1494              OneSamp.Free;
1495            end;
1496          end;
1497        if (not UniqueCollSamp) and (CollSampList.Count = 0) then LoadAllSamples;
1498        CollSampCount := CollSampList.Count;
1499      end;
1500    finally
1501      LoadData.Free;
1502    end;
1503    SetCollSampDflts;
1504  end;
1505  
1506  destructor TLabTest.Destroy;
1507  var
1508    i: Integer;
1509  begin
1510    if CollSampList <> nil then
1511      with CollSampList do for i := 0 to Count - 1 do
1512       with TCollSamp(Items[i]) do
1513        begin
1514          WardComment.Free;
1515          Free;
1516        end;
1517    CollSampList.Free;
1518    SpecimenList.Free;
1519    UrgencyList.Free;
1520    CurWardComment.Free;
1521    Comment.Free;
1522    inherited Destroy;
1523  end;
1524  
1525  function TLabTest.IndexOfCollSamp(CollSampIEN: Integer): Integer;
1526  var
1527    i: Integer;
1528  begin
1529    Result := -1;
1530    with CollSampList do for i := 0 to Count - 1 do with TCollSamp(Items[i]) do
1531      if CollSampIEN = CollSampID then
1532      begin
1533        Result := i;
1534        break;
1535      end;
1536  end;
1537  
1538  procedure TLabTest.LoadAllSamples;
1539  var
1540    LoadList, SpecList: TStringList;
1541    i: Integer;
1542  begin
1543    LoadList := TStringList.Create;
1544    SpecList := TStringList.Create;
1545    try
1546      LoadSamples(LoadList) ;
1547      FillCollSampList(LoadList, 0);
1548      ExtractItems(SpecList, LoadList, 'Specimens');
1549      with SpecList do for i := 0 to Count - 1 do
1550        if SpecimenList.IndexOf(Strings[i]) = -1 then SpecimenList.Add(Strings[i]);
1551    finally
1552      LoadList.Free;
1553      SpecList.Free;
1554    end;
1555  end;
1556  
1557  procedure TLabTest.FillCollSampList(LoadData: TStringList; DfltCollSamp: Integer);
1558  {1  2        3         4       5         6          7         8          9               10   }
1559  {n^IEN^CollSampName^SpecIEN^TubeTop^MinInterval^MaxPerDay^LabCollect^SampReqCommentIEN;name^SpecName}
1560  var
1561    i, LastListItem, AnIndex: Integer;
1562    ACollSamp: TCollSamp;
1563    LabCollSamp: Integer;
1564  begin
1565    i := -1;
1566    if CollSampList = nil then CollSampList := TList.Create;
1567    LastListItem := CollSampList.Count ;
1568    LabCollSamp := StrToIntDef(ExtractDefault(LoadData, 'Lab CollSamp'), 0);
1569    repeat Inc(i) until (i = LoadData.Count) or (LoadData[i] = '~CollSamp');
1570    Inc(i);
1571    if i < LoadData.Count then repeat
1572      if LoadData[i][1] = 'i' then
1573        begin
1574          ACollSamp := TCollSamp.Create;
1575          with ACollSamp do
1576            begin
1577              AnIndex         := StrToIntDef(Copy(Piece(LoadData[i], '^', 1), 2, 999), -1);
1578              CollSampID      := StrToInt(Piece(LoadData[i], '^', 2));
1579              CollSampName    := Piece(LoadData[i], '^', 3);
1580              SpecimenID      := StrToIntDef(Piece(LoadData[i], '^', 4), 0);
1581              SpecimenName    := Piece(LoadData[i], '^', 10);
1582              TubeColor       := Piece(LoadData[i], '^', 5);
1583              MinInterval     := StrToIntDef(Piece(LoadData[i], '^', 6), 0);
1584              MaxPerDay       := StrToIntDef(Piece(LoadData[i], '^', 7), 0);
1585              LabCanCollect   := AnIndex = LabCollSamp;
1586              SampReqComment  := Piece(LoadData[i], '^', 9);
1587              WardComment     := TStringList.Create;
1588              if CollSampID  = StrToIntDef(LRFSAMP, 0) then
1589                CollSamp := CollSampID
1590              else if AnIndex = DfltCollSamp then
1591                CollSamp := CollSampID;
1592            end; {with}
1593          LastListItem := CollSampList.Add(ACollSamp);
1594        end; {if}
1595      if (LoadData[i][1] = 't') then
1596        TCollSamp(CollSampList.Items[LastListItem]).WardComment.Add(Copy(LoadData[i], 2, 255));
1597      Inc(i);
1598    until (i = LoadData.Count) or (LoadData[i][1] = '~');
1599  end;
1600  
1601  procedure TLabTest.SetCollSampDflts;
1602  var
1603    tmpResp: TResponse;
1604  begin
1605    Specimen := 0;
1606    Comment.Clear;
1607    CurReqComment := TestReqComment;
1608    if CollSamp = 0 then Exit;
1609    with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN'  ,1);
1610    if (LRFSPEC <> '') and (tmpResp = nil) then
1611      ChangeSpecimen(LRFSPEC)
1612    else with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
1613      begin
1614        Specimen := SpecimenID;
1615        if SampReqcomment <> '' then CurReqComment := SampReqComment;
1616      end;
1617  end;
1618  
1619  procedure TLabTest.ChangeCollSamp(CollSampIEN: Integer);
1620  begin
1621    CollSamp := CollSampIEN;
1622    SetCollSampDflts;
1623  end;
1624  
1625  procedure TLabTest.ChangeSpecimen(const SpecimenIEN: string);
1626  begin
1627    Specimen := StrToIntDef(SpecimenIEN,0);
1628  end;
1629  
1630  procedure TLabTest.ChangeComment(const CommentText: string);
1631  begin
1632    Comment.Add(CommentText);
1633  end;
1634  
1635  function TLabTest.LabCanCollect: Boolean;
1636  var
1637    i: Integer;
1638  begin
1639    Result := False;
1640    i := IndexOfCollSamp(CollSamp);
1641    if i > -1 then with TCollSamp(CollSampList.Items[i]) do Result := LabCanCollect;
1642  end;
1643  
1644  procedure TLabTest.LoadCollSamp(AComboBox: TORComboBox);
1645  { loads the collection sample combo box, expects CollSamp to already be set to default }
1646  var
1647    i: Integer;
1648    x: string;
1649  begin
1650    AComboBox.Clear;
1651    with CollSampList do for i := 0 to Count - 1 do with TCollSamp(Items[i]) do
1652    begin
1653      x := IntToStr(CollSampID) + '^' + CollSampName;
1654      if Length(TubeColor) <> 0 then x := x + ' (' + TubeColor + ')';
1655      AComboBox.Items.Add(x);
1656      if CollSamp = CollSampID then AComboBox.ItemIndex := i;
1657    end;
1658    if ((ALabTest.LabSubscript = 'CH') and (not UserHasLRLABKey)) then
1659      begin
1660        // do not add 'Other'   (coded this way for clarity)
1661      end
1662    else
1663      with AComboBox do
1664        begin
1665          Items.Add('0^Other...');
1666          if ItemIndex < 0 then ItemIndex := Items.IndexOf('Other...');
1667        end;
1668  end;
1669  
1670  procedure TLabTest.LoadSpecimen(AComboBox: TORComboBox);
1671  { loads specimen combo box, if SpecimenList is empty, use 'E' xref on 61 ?? }
1672  var
1673    i: Integer;
1674    tmpResp: TResponse;
1675  begin
1676    AComboBox.Clear;
1677    if ObtainSpecimen then
1678      begin
1679        if SpecimenList.Count = 0 then LoadSpecimens(SpecimenList) ;
1680        FastAssign(SpecimenList, AComboBox.Items);
1681        AComboBox.Items.Add('0^Other...');
1682        with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN'  ,1);
1683        if (LRFSPEC <> '') and (tmpResp = nil) then
1684          AComboBox.SelectByID(LRFSPEC)
1685        else if Specimen > 0 then
1686          AComboBox.SelectByIEN(Specimen)
1687        else
1688          AComboBox.ItemIndex := AComboBox.Items.IndexOf('Other...');
1689      end
1690    else
1691      begin
1692        i := IndexOfCollSamp(CollSamp);
1693        if i < CollSampList.Count then with TCollSamp(CollSampList.Items[i]) do
1694          begin
1695            AComboBox.Items.Add(IntToStr(SpecimenID) + '^' + SpecimenName);
1696            AComboBox.ItemIndex := 0;
1697          end;
1698        with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN'  ,1);
1699        if (LRFSPEC <> '') and (tmpResp = nil) then
1700          begin
1701            AComboBox.Items.Add(GetOneSpecimen(StrToInt(LRFSPEC)));
1702            AComboBox.SelectByID(LRFSPEC);
1703          end;
1704      end;
1705    ChangeSpecimen(AComboBox.ItemID);
1706  end;
1707  
1708  procedure TLabTest.LoadUrgency(CollType: string; AComboBox:TORComboBox);
1709  var
1710    i, PreviousSelectionIndex: integer;
1711    PreviousSelectionString: String;
1712  begin
1713    if UrgencyList.Count < 1 then Exit;
1714    with AComboBox do
1715      begin
1716       PreviousSelectionIndex := -1;
1717       PreviousSelectionString := SelText;
1718        Clear;
1719        for i := 0 to UrgencyList.Count - 1 do
1720          begin
1721           if (CollType = 'LC') and (Piece(UrgencyList[i], U, 3) = '') then
1722             Continue
1723           else
1724             Items.Add(UrgencyList[i]);
1725           if (PreviousSelectionString <> '') and (PreviousSelectionString = Piece(UrgencyList[i], U, 2)) then
1726             PreviousSelectionIndex := i;
1727          end;
1728        if (LRFURG <> '') and (ALabTest.ObtainUrgency) then
1729          SelectByID(LRFURG)
1730        else if PreviousSelectionIndex > -1 then
1731          ItemIndex := PreviousSelectionIndex
1732        else
1733          SelectByIEN(uDfltUrgency);
1734        Urgency := AComboBox.ItemIEN;
1735      end;
1736  end;
1737  
1738  function TLabTest.NameOfCollSamp: string;
1739  var
1740    i: Integer;
1741  begin
1742    Result := '';
1743    i := IndexOfCollSamp(CollSamp);
1744    if i > -1 then with TCollSamp(CollSampList.Items[i]) do Result := CollSampName;
1745  end;
1746  
1747  function TLabTest.NameOfSpecimen: string;
1748  var
1749    i: Integer;
1750  begin
1751    Result := '';
1752    if CollSamp > 0 then with TCollSamp(CollSampList[IndexOfCollSamp(CollSamp)]) do
1753      if (Specimen > 0) and (Specimen = SpecimenID) then Result := SpecimenName;
1754    if (Length(Result) = 0) and (Specimen > 0) then with SpecimenList do
1755      for i := 0 to Count - 1 do if Specimen = StrToInt(Piece(Strings[i], '^', 1)) then
1756      begin
1757        Result := Piece(Strings[i], '^', 2);
1758        break;
1759      end;
1760  end;
1761  
1762  function TLabTest.NameOfUrgency: string;
1763  var
1764    i: Integer;
1765  begin
1766    Result := '';
1767    with UrgencyList do for i := 0 to Count - 1 do
1768    begin
1769      if StrToInt(Piece(Strings[i], '^', 1)) = Urgency
1770        then Result := Piece(Strings[i], '^', 2);
1771      break;
1772    end;
1773  end;
1774  
1775  function TLabTest.ObtainCollSamp: Boolean;
1776  begin
1777    Result := (not UniqueCollSamp);
1778  end;
1779  
1780  function TLabTest.ObtainSpecimen: Boolean;
1781  var
1782    i: Integer;
1783  begin
1784    Result := True;
1785    i := IndexOfCollSamp(CollSamp);
1786    if (i > -1) and (i < CollSampList.Count) then with TCollSamp(CollSampList.Items[i]) do
1787      if SpecimenID > 0 then Result := False;
1788  end;
1789  
1790  function TLabTest.ObtainUrgency: Boolean;
1791  begin
1792    Result := not ForceUrgency;
1793  end;
1794  
1795  function TLabTest.ObtainComment: Boolean;
1796  begin
1797    Result := Length(CurReqComment) > 0;
1798  end;
1799  
1800  procedure TfrmODBBank.ExtractModifiers(OutList:TStrings; AList:TStrings);
1801  begin
1802    ExtractItems(Outlist, AList,'MODIFIERS');
1803  end;
1804  
1805  procedure TfrmODBBank.ExtractReasons(OutList:TStrings; AList:TStrings);
1806  begin
1807    ExtractItems(Outlist, AList,'REASONS');
1808  end;
1809  
1810  procedure TfrmODBBank.ExtractUrgencies(OutList:TStrings; AList:TStrings);
1811  begin
1812    ExtractItems(Outlist, AList,'URGENCIES');
1813  end;
1814  
1815  procedure TfrmODBBank.ExtractTNSOrders(OutList:TStrings; AList:TStrings);
1816  begin
1817    ExtractItems(Outlist, AList,'TNS ORDERS');
1818  end;
1819  
1820  procedure TfrmODBBank.ExtractSurgeries(OutList:TStrings; AList:TStrings);
1821  begin
1822    ExtractItems(OutList, AList,'SURGERIES');
1823  end;
1824  
1825  procedure TfrmODBBank.ExtractSpecimens(OutList:TStrings; AList:TStrings);
1826  begin
1827    ExtractItems(OutList, AList,'SPECIMENS');
1828  end;
1829  
1830  procedure TfrmODBBank.ExtractTypeScreen(OutList:TStrings; AList:TStrings);
1831  begin
1832    ExtractItems(OutList, AList, 'TYPE AND SCREEN');
1833  end;
1834  
1835  procedure TfrmODBBank.ExtractOther(OutList:TStrings; AList:TStrings);
1836  begin
1837    ExtractItems(OutList, AList, 'OTHER');
1838  end;
1839  
1840  procedure TfrmODBBank.ExtractSpecimen(OutList:TStrings; AList:TStrings);
1841  begin
1842    ExtractItems(OutList, AList, 'SPECIMEN');
1843  end;
1844  
1845  procedure TfrmODBBank.ExtractPatientInfo(OutList:TStrings; AList:TStrings);
1846  begin
1847    ExtractItems(OutList, AList, 'INFO');
1848  end;
1849  
1850  procedure TfrmODBBank.ExtractTests(OutList:TStrings; AList:TStrings);
1851  begin
1852    ExtractItems(OutList, AList, 'TESTS');
1853  end;
1854  
1855  procedure TfrmODBBank.ExtractMSBOS(OutList:TStrings; AList:TStrings);
1856  begin
1857    ExtractItems(OutList, AList, 'MSBOS');
1858  end;
1859  
1860  function TfrmODBBank.SpecimenNeeded(OutList:TStrings; AList:TStrings; CompID:integer): Boolean;
1861  var
1862    i:integer;
1863    aborh: boolean;
1864    aSpecimen, aSpecimenUID, aSpecimenDate: string;
1865    aWantDateTime, aExpiredSpecimenDate: TFMDateTime;
1866  begin
1867    result := false;
1868    aborh := false;
1869    aSpecimen := '';
1870    aSpecimenUID := '';
1871    OutList.Clear;
1872    ExtractItems(OutList,Alist,'ABORH');
1873    for i := 0 to OutList.Count - 1 do
1874      begin
1875        if Length(OutList[i])>1 then
1876          begin
1877            aborh := true;
1878          end;
1879      end;
1880    if aborh = false then
1881      begin
1882        result := true;
1883        exit;
1884      end;
1885    OutList.Clear;
1886    ExtractSpecimen(OutList, uVBECList);
1887    if OutList.Count > 0 then
1888      begin
1889        aSpecimen := Piece(OutList[0], '^',1);
1890        aSpecimenUID := Piece(OutList[0], '^',2);
1891      end;
1892    OutList.Clear;
1893    ExtractItems(OutList,AList,'SPECIMENS');
1894    aWantDateTime := calWantTime.FMDateTime;
1895    aSpecimenDate := aSpecimen;
1896    aExpiredSpecimenDate := 0;
1897    if Length(aSpecimenDate) > 0 then aExpiredSpecimenDate := StrToFloat(aSpecimenDate);
1898    for i := 0 to OutList.Count - 1 do
1899      begin
1900        if (IntToStr(aLabTest.ItemID) = piece(OutList[i],'^',1)) and (piece(OutList[i],'^',2) = '1') then
1901          begin
1902            if self.EvtID > 0 then
1903              begin
1904                result := true;
1905                exit;
1906              end;
1907            if aSpecimen = '' then
1908              begin
1909                result := true;
1910                exit;
1911              end
1912            else if (Length(calWantTime.Text) > 0) and (aExpiredSpecimenDate < aWantDateTime) then
1913              begin
1914                result := true;
1915                exit;
1916              end;
1917          end;
1918      end;
1919  end;
1920  
1921  procedure TfrmODBBank.Validate(var AnErrMsg: string);
1922  
1923    procedure SetError(const x: string);
1924    begin
1925      if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
1926      AnErrMsg := AnErrMsg + x;
1927    end;
1928  
1929  const
1930    TX_NO_TESTS       = 'No Tests or Components selected' ;
1931    TX_TNS_REQUIRED   = 'An order for TYPE and SCREEN must be created for this order set' ;
1932  
1933  begin
1934    inherited;
1935    if uSelectedItems.Count < 1 then
1936      begin
1937        SetError(TX_NO_TESTS);
1938        Exit;
1939      end;
1940    if uGetTns = 1 then
1941      begin
1942        SetError(TX_TNS_REQUIRED);
1943        Exit;
1944      end;
1945    ValidateAdd(AnErrMsg);
1946  end;
1947  
1948  procedure TfrmODBBank.ValidateAdd(var AnErrMsg: string);
1949  
1950    procedure SetError(const x: string);
1951      begin
1952        if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
1953        AnErrMsg := AnErrMsg + x;
1954      end;
1955  
1956  var
1957    aList: TStringList;
1958    i, DaysofFuturePast: integer;
1959    d1, d2: TDateTime;
1960    x,test,aOther: string;
1961  const
1962    {Diagnostic Test Errors}
1963    TX_NO_TIME        = 'Collection Time is required' ;
1964    TX_NO_TCOLLTYPE   = 'Collection Type is required' ;
1965    TX_NO_TESTS       = 'A Lab Test or tests must be selected' ;
1966    TX_BAD_TIME       = 'Collection times must be chosen from the drop down list or entered as valid' +
1967                        ' Fileman date/times (T@1700, T+1@0800, etc.)' ;
1968    TX_PAST_TIME      = 'Collection times in the past are not allowed';
1969    TX_NO_DAYS        = 'A number of days must be entered for continuous orders';
1970    TX_NO_TIMES       = 'A number of times must be entered for continuous orders';
1971    TX_NO_STOP_DATE   = 'Could not calculate the stop date for the order.  Check "for n Days"';
1972    TX_TOO_MANY_DAYS  = 'Maximum number of days allowed is ';
1973    TX_TOO_MANY_TIMES = 'For this frequency, the maximum number of times allowed is:  X';
1974    TX_NUMERIC_REQD   = 'A numeric value is required for urine volume';
1975    TX_DOSEDRAW_REQD  = 'Both DOSE and DRAW times are required for this order';
1976    TX_TDM_REQD       = 'A value for LEVEL is required for this order';
1977    TX_NO_COLLSAMPLE  = 'A collection sample MUST be specified';
1978    TX_NO_SPECIMEN    = 'A specimen MUST be specified';
1979    TX_NO_URGENCY     = 'An urgency MUST be specified';
1980    TX_NO_FREQUENCY   = 'A collection frequency MUST be specified';
1981    TX_NOT_LAB_COLL_TIME = ' is not a routine lab collection time';
1982    TX_NO_ALPHA       = 'For continuous orders, enter a number of days, or an "X" followed by a number of times';
1983    TX_BADTIME_CAP    = 'Invalid Immediate Collect Time';
1984    {Component/Type & Screen Errors}
1985    TX_NO_COMPONENTS  = 'A Blood Product MUST be selected';
1986    TX_NO_QUANTITY    = 'The number of units MUST be specified under "Quantity"';
1987    TX_HIGH_QUANTITY  = 'Quantity too high';
1988    TX_NO_DATEMODIFIED= 'A Date/time Wanted MUST be specified';
1989    TX_NO_SURGERY     = 'A Surgery MUST be specified for Pre-Op orders';         //only if Pre-op selected
1990    TX_NO_REASON      = 'A Reason for Request MUST be entered';
1991    TX_REASON_TOO_LONG= 'Reason for Request MUST be less than 76 characters long';
1992    TX_MODIFIER_TOO_LONG = 'Modifer text MUST be less than 51 characters long';
1993    TX_NO_COMMENT     = 'A Comment MUST be entered for this Component';
1994    TX_DUPLICATE      = 'Duplicate Test/Component not allowed';
1995    TX_NO_TEST_SELECTED = 'No Test/Component selected';
1996  
1997  begin
1998    inherited;
1999    AnErrMsg := '';
2000    aList := TStringList.Create;
2001    try
2002      ExtractOther(aList, uVBECList);
2003      if aList.Count > 0 then aOther := aList[0];
2004      aList.Clear;
2005      if uSelectedItems.Count < 1 then
2006        begin
2007          AnErrMsg := TX_NO_TEST_SELECTED;
2008          Exit;
2009        end;
2010      for i := 0 to uSelectedItems.Count - 1 do
2011        begin
2012          x := uSelectedItems[i];
2013          test := lvSelectionList.Items[i].Caption;
2014          if piece(x,'^',1) = '1' then    //Diagnostic Test
2015            begin
2016              if uSpecimen = 0 then
2017                if cboCollType.ItemID = '' then
2018                  SetError(TX_NO_TCOLLTYPE + ' (' + test + ')')
2019                else if cboCollType.ItemID = 'LC' then
2020                  begin
2021                   if Length(cboCollTime.Text) = 0 then SetError(TX_NO_TIME + ' (' + test + ')');
2022                   with cboCollTime do if (Length(Text) > 0) and (ItemIndex = -1) then
2023                     begin
2024                       if StrToFMDateTime(Text) < 0 then
2025                         SetError(TX_BAD_TIME + ' (' + test + ')')
2026                       else if StrToFMDateTime(Text) < FMNow then
2027                         SetError(TX_PAST_TIME + ' (' + test + ')')
2028                       else if OrderForInpatient then
2029                         begin
2030                           d1 := FMDateTimeToDateTime(Trunc(StrToFMDateTime(cboColltime.Text)));
2031                           d2 := FMDateTimeToDateTime(FMToday);
2032                           if EvtDelayLoc > 0 then
2033                             DaysofFuturePast := LabCollectFutureDays(EvtDelayLoc,EvtDivision)
2034                           else
2035                             DaysofFuturePast := LabCollectFutureDays(Encounter.Location);
2036                           if DaysofFuturePast = 0 then DaysofFuturePast := 7;
2037                           if ((d1 - d2) > DaysofFuturePast) then
2038                             SetError('A lab collection cannot be ordered more than '
2039                               + IntToStr(DaysofFuturePast) + ' days in advance');
2040                         end
2041                       else if EvtDelayLoc > 0 then
2042                         begin
2043                           if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), EvtDelayLoc)) then
2044                             SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME + ' (' + test + ')');
2045                         end
2046                       else if EvtDelayLoc <= 0 then
2047                         begin
2048                           if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), Encounter.Location)) then
2049                             SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME + ' (' + test + ')');
2050                         end;
2051                     end;
2052                  end
2053                else
2054                  begin
2055                    if cboCollType.ItemID = 'I' then
2056                      begin
2057                        calCollTime.Text := txtImmedColl.Text;
2058                        x := ValidImmCollTime(calCollTime.FMDateTime);
2059                        if (Piece(x, U, 1) <> '1') then
2060                          SetError(Piece(x, U, 2));
2061                      end;
2062  
2063                    with calColltime do
2064                      begin
2065                        if FMDateTime = 0 then SetError(TX_BAD_TIME + ' (' + test + ')')
2066                        else
2067                          begin
2068                            // date only was entered
2069                            if (FMDateTime - Trunc(FMDateTime) = 0) then
2070                              begin
2071                                if (Trunc(FMDateTime) < FMToday) then SetError(TX_PAST_TIME + ' (' + test + ')');
2072                              end
2073                            // date/time was entered
2074                            else
2075                              begin
2076                                if (UpperCase(Text) <> 'NOW') and (FMDateTime < FMNow) then SetError(TX_PAST_TIME + ' (' + test + ')');
2077                              end;
2078                          end;
2079                      end;
2080                  end;
2081  
2082              with cboUrgency do if ItemIEN  <= 0 then SetError(TX_NO_URGENCY + ' (' + test + ')');
2083            end
2084          else                            //Component
2085            begin
2086              if piece(x,'^',3) ='' then SetError(TX_NO_QUANTITY + ' (' + test + ')')
2087                else
2088                  begin
2089                    if StrToInt(piece(x,'^',3)) < 1 then SetError(TX_NO_QUANTITY + ' (' + test + ')');
2090                    if StrToInt(piece(x,'^',3)) > 100 then SetError(TX_HIGH_QUANTITY + ' (' + test + ')');
2091                  end;
2092              if calWantTime.Text = '' then SetError(TX_NO_DATEMODIFIED + ' (' + test + ')');
2093              if (cboReasons.Text = '') and not(uReason = '') then
2094                begin
2095                  SetError(TX_NO_REASON + ' (' + test + ').' + ' Previously entered ''Reason for Request'' will be retained.');
2096                  cboReasons.Text := uReason; //reset reason back to previous value
2097                end;
2098                if (cboReasons.Text = '') then
2099                  begin
2100                    SetError(TX_NO_REASON + ' (' + test + ').');
2101                  end;
2102              if (memDiagComment.Text = '') and (piece(x,'^',2) = aOther) then SetError(TX_NO_COMMENT + ' (' + test + ')');
2103              if (cboUrgency.Text = 'PRE-OP') and (length(cboSurgery.Text) < 1) then SetError(TX_NO_SURGERY + ' (' + test + ')');
2104              if (length(cboReasons.Text) > 75) then SetError(TX_REASON_TOO_LONG);
2105              if (length(cboModifiers.Text) > 50) then SetError(TX_MODIFIER_TOO_LONG);
2106            end;
2107        end;
2108    finally
2109      aList.Free;
2110    end;
2111  end;
2112  
2113  function TfrmODBBank.ValidAdd: Boolean;
2114  const
2115    TX_NO_SAVE     = 'This item cannot be added for the following reason(s):' + CRLF + CRLF;
2116    TX_NO_SAVE_CAP = 'Unable to Add item';
2117    TX_SAVE_ERR    = 'Unexpected error - it was not possible to Add this item.';
2118  var
2119    ErrMsg: string;
2120  
2121  begin
2122    Result := True;
2123    ValidateAdd(ErrMsg);
2124    if Length(ErrMsg) > 0 then
2125    begin
2126      InfoBox(TX_NO_SAVE + ErrMsg, TX_NO_SAVE_CAP, MB_OK);
2127      Result := False;
2128      Exit;
2129    end;
2130  end;
2131  
2132  function TfrmODBBank.ValidCollTime(UserEntry: string): string;
2133  var
2134    i: integer;
2135  const
2136    FMDateResponses: array[0..3] of string = ('TODAY','NOW','NOON','MID');
2137  begin
2138    Result := '';
2139    UserEntry := UpperCase(UserEntry);
2140    if StrToFMDateTime(UserEntry) < 0 then exit;
2141    if (UserEntry = 'T') or
2142       (UserEntry = 'N') or
2143       (Copy(UserEntry,1,2)='T+') or
2144       (Copy(UserEntry,1,2)='T@') or
2145       (Copy(UserEntry,1,2)='T-') or
2146       (Copy(UserEntry,1,2)='N+') then Result := UserEntry
2147    else
2148       for i := 0 to 3 do if Pos(FMDateResponses[i],UserEntry)>0 then Result := UserEntry ;
2149    if Result = '' then Result := FloatToStr(StrToFMDateTime(UserEntry));
2150  end;
2151  
2152  procedure TfrmODBBank.GetAllCollSamples(AComboBox: TORComboBox);
2153  var
2154    OtherSamp: string;
2155  begin
2156    with ALabTest, AComboBox do
2157      begin
2158        if ((CollSampList.Count + 1) <= AComboBox.Items.Count) then LoadAllSamples;
2159        OtherSamp := SelectOtherCollSample(Font.Size, CollSampCount, CollSampList);
2160        if OtherSamp = '-1' then exit;
2161        if SelectByID(Piece(OtherSamp, U, 1)) = -1 then
2162          if Items.Count > CollSampCount + 1 then
2163            Items[0] := OtherSamp
2164          else
2165            Items.Insert(0, OtherSamp) ;
2166        SelectByID(Piece(OtherSamp, U, 1));
2167        AComboBox.OnChange(Self);
2168        ActiveControl := cmdAccept;
2169      end;
2170  end;
2171  
2172  procedure TfrmODBBank.GetAllSpecimens(AComboBox: TORComboBox);
2173  var
2174    OtherSpec: string;
2175  begin
2176    inherited;
2177    if ALabTest <> nil then
2178      with ALabTest, AComboBox do
2179        begin
2180          AComboBox.DroppedDown := False;
2181          OtherSpec := SelectOtherSpecimen(Font.Size, SpecimenList);
2182          if OtherSpec = '-1' then exit;
2183          if SelectByID(Piece(OtherSpec, U, 1)) = -1 then
2184            if Items.Count > SpecListCount + 1 then
2185              Items[0] := OtherSpec
2186            else
2187              Items.Insert(0, OtherSpec) ;
2188          SpecimenList.Add(OtherSpec);
2189          SelectByID(Piece(OtherSpec, U, 1));
2190          AComboBox.OnChange(Self);
2191        end;
2192  end;
2193  
2194  procedure TfrmODBBank.SetupCollTimes(CollType: string);
2195  var
2196    tmpImmTime, tmpTime: TFMDateTime;
2197    x, tmpORECALLType, tmpORECALLTime: string;
2198    j: integer;
2199    havetest: boolean;
2200  begin
2201    havetest := false;
2202    for j := uSelectedItems.Count - 1 downto 0 do
2203      begin
2204        if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '1') and ((length(calCollTime.Text) > 0) or (length(cboCollTime.Text) > 0)) then
2205          begin
2206            havetest := true;
2207            Break;
2208          end;
2209      end;
2210    //if (havetest = True) and (not(FOrderAction in [ORDER_QUICK, ORDER_EDIT])) then havetest := false;
2211    x := GetLastCollectionTime;
2212    tmpORECALLType := Piece(x, U, 1);
2213    tmpORECALLTime := Piece(x, U, 2);
2214    if CollType = 'SP' then
2215      begin
2216        cboColltime.Visible    := False;
2217        txtImmedColl.Visible   := False;
2218        pnlCollTimeButton.Visible   := False;
2219        pnlCollTimeButton.TabStop := False;
2220        calCollTime.Visible    := True;
2221        calCollTime.Enabled    := True;
2222        if FLastCollTime <> '' then
2223          begin
2224            calCollTime.Text := ValidCollTime(FLastColltime);
2225            if IsFMDateTime(calCollTime.Text) then
2226              begin
2227                calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
2228                calCollTime.FMDateTime := StrToFMDateTime(FLastCollTime);
2229              end;
2230          end
2231        else if tmpORECALLTime <> '' then
2232          begin
2233            calCollTime.Text := ValidCollTime(tmpORECALLTime);
2234            if IsFMDateTime(calCollTime.Text) then
2235              begin
2236                calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
2237                calCollTime.FMDateTime := StrToFMDateTime(tmpORECALLTime);
2238              end;
2239          end
2240        else if LRFDATE <> '' then
2241          calCollTime.Text     := LRFDATE
2242        else if not(FOrderAction in [ORDER_EDIT]) then
2243          calCollTime.Text     := 'TODAY'
2244        else if (havetest = false) then
2245          calCollTime.Text     := 'TODAY';
2246       if (havetest = false) and (RemoveCollTimeDefault = True) then
2247          begin
2248            calCollTime.Text := '';
2249            calCollTime.FMDateTime := 0;
2250          end;
2251      end
2252    else if CollType = 'WC' then
2253      begin
2254        cboColltime.Visible    := False;
2255        txtImmedColl.Visible   := False;
2256        pnlCollTimeButton.Visible   := False;
2257        pnlCollTimeButton.TabStop := False;
2258        calCollTime.Visible    := True;
2259        calColltime.Enabled    := True;
2260        if FLastCollTime <> '' then
2261          begin
2262            calCollTime.Text := ValidCollTime(FLastColltime);
2263            if IsFMDateTime(calCollTime.Text) then
2264              begin
2265                calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
2266                calCollTime.FMDateTime := StrToFMDateTime(FLastCollTime);
2267              end;
2268          end
2269        else if tmpORECALLTime <> '' then
2270          begin
2271            calCollTime.Text := ValidCollTime(tmpORECALLTime);
2272            if IsFMDateTime(calCollTime.Text) then
2273              begin
2274                calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
2275                calCollTime.FMDateTime := StrToFMDateTime(tmpORECALLTime);
2276              end;
2277          end
2278        else if LRFDATE <> '' then
2279          calCollTime.Text     := LRFDATE
2280        else if not(FOrderAction in [ORDER_EDIT]) then
2281          calCollTime.Text     := 'NOW';
2282        if (havetest = false) and (RemoveCollTimeDefault = True) then
2283          begin
2284            calCollTime.Text := '';
2285            calCollTime.FMDateTime := 0;
2286          end;
2287      end
2288    else if CollType = 'LC' then
2289      begin
2290        cboColltime.Visible    := True;
2291        calCollTime.Visible    := False;
2292        calColltime.Enabled    := False;
2293        txtImmedColl.Visible   := False;
2294        pnlCollTimeButton.Visible   := False;
2295        pnlCollTimeButton.TabStop := False;
2296        with CtrlInits do SetControl(cboCollTime, 'Lab Collection Times');
2297        if Pos(U, FLastLabCollTime) > 0 then
2298          cboColltime.SelectByID(Piece(FLastLabCollTime, U, 1))
2299        else if FLastLabCollTime <> '' then
2300          cboCollTime.Text     := FLastLabCollTime
2301        else if (tmpORECALLTime <> '') and (tmpORECALLType = 'LC') then
2302          cboCollTime.Text     := MakeRelativeDateTime(StrToFMDateTime(tmpORECALLTime))
2303        else if LRFDATE <> '' then
2304          cboCollTime.Text     := LRFDATE
2305        else
2306          cboCollTime.ItemIndex := 0;
2307        if (havetest = false) and (RemoveCollTimeDefault = True) then
2308          begin
2309            cboCollTime.Text := '';
2310          end;
2311      end
2312    else if CollType = 'I' then
2313      begin
2314        cboColltime.Visible    := False;
2315        calCollTime.Visible    := False;
2316        calCollTime.Enabled    := False;
2317        txtImmedColl.Visible   := True;
2318        pnlCollTimeButton.Visible   := True;
2319        pnlCollTimeButton.TabStop := True;
2320        tmpImmTime := GetDefaultImmCollTime;
2321        tmpTime := 0;
2322        if (FLastColltime <> '') then
2323          tmpTime := StrToFMDateTime(FLastColltime)
2324        else if (tmpORECALLTime <> '') then
2325          tmpTime := StrToFMDateTime(tmpORECALLTime)
2326        else if LRFDATE <> '' then
2327          tmpTime := StrToFMDateTime(LRFDATE);
2328        if tmpTime > tmpImmTime then
2329          begin
2330            calCollTime.FMDateTime := tmpTime;
2331            txtImmedColl.Text      := FormatFMDateTime('mmm dd,yy@hh:nn', tmpTime);
2332          end
2333        else
2334          begin
2335            calCollTime.FMDateTime := GetDefaultImmCollTime;
2336            txtImmedColl.Text      := FormatFMDateTime('mmm dd,yy@hh:nn', calCollTime.FMDateTime);
2337          end;
2338        if (havetest = false) and (RemoveCollTimeDefault = True) then
2339          begin
2340            calCollTime.Text := '';
2341            calCollTime.FMDateTime := 0;
2342            txtImmedColl.Text := '';
2343          end;
2344      end;
2345  end;
2346  
2347  procedure TfrmODBBank.LoadCollType(AComboBox:TORComboBox);
2348  var
2349    i: integer;
2350  begin
2351    with CtrlInits, cboCollType do
2352      begin
2353        SetControl(cboCollType, 'Collection Types');
2354        if not ALabTest.LabCanCollect then
2355          begin
2356            i := SelectByID('LC');
2357            if i > -1 then Items.Delete(i);
2358            i := SelectByID('I');
2359            if i > -1 then Items.Delete(i);
2360          end ;
2361        if LRFZX <> '' then
2362          begin
2363            if (LRFZX = 'LC') or (LRFZX = 'I') then
2364              begin
2365                if ALabTest.LabCanCollect then
2366                  cboCollType.SelectByID(LRFZX)
2367                else
2368                  cboCollType.SelectByID('WC');
2369              end
2370            else
2371              cboCollType.SelectByID(LRFZX);
2372          end
2373        else if FLastCollType <> '' then
2374          begin
2375            if (FLastCollType = 'LC') or (FLastCollType = 'I') then
2376              begin
2377                if ALabTest.LabCanCollect then
2378                  cboCollType.SelectByID(FLastCollType)
2379                else
2380                  cboCollType.SelectByID('WC');
2381              end
2382            else
2383              cboCollType.SelectByID(FLastCollType);
2384          end
2385        else if uDfltCollType <> '' then
2386          begin
2387            if (uDfltCollType = 'LC') or (uDfltCollType = 'I') then
2388              begin
2389                if ALabTest.LabCanCollect then
2390                  cboCollType.SelectByID(uDfltCollType)
2391                else
2392                  cboCollType.SelectByID('WC');
2393              end
2394            else
2395              cboCollType.SelectByID(uDfltCollType);
2396          end
2397        else if OrderForInpatient then
2398          begin
2399            if ALabTest.LabCanCollect then
2400              cboCollType.SelectByID('LC')
2401            else
2402              SelectByID('WC');
2403          end
2404        else
2405          cboCollType.SelectByID('SP');
2406      end;
2407    SetupCollTimes(cboCollType.ItemID);
2408  end;
2409  
2410  procedure  TfrmODBBank.ReadServerVariables;
2411  begin
2412    LRFZX   := KeyVariable['LRFZX'];
2413    LRFSAMP := KeyVariable['LRFSAMP'];
2414    LRFSPEC := KeyVariable['LRFSPEC'];
2415    LRFDATE := KeyVariable['LRFDATE'];
2416    LRFURG  := KeyVariable['LRFURG'];
2417    LRFSCH  := KeyVariable['LRFSCH'];
2418  end;
2419  
2420  procedure TfrmODBBank.cboQuickClick(Sender: TObject);
2421  begin
2422    inherited;
2423    SetOnQuickOrder;
2424  end;
2425  
2426  procedure TfrmODBBank.cboReasonsChange(Sender: TObject);
2427  begin
2428    inherited;
2429    cboReasons.Text := StringReplace(cboReasons.Text,CRLF,'  ',[rfReplaceAll]);
2430    if (length(cboReasons.Text) > 75) then
2431      begin
2432        ShowMsg('REASON FOR REQUEST cannot be longer than 75 characters');
2433        cboReasons.Text := Copy(cboReasons.Text,0,75);
2434        Exit;
2435      end;
2436    if Length(cboReasons.Text) > 0 then Responses.Update('REASON', 1, cboReasons.Text, cboReasons.Text);
2437    memOrder.Text := Responses.OrderText;
2438  end;
2439  
2440  procedure TfrmODBBank.cboReasonsEnter(Sender: TObject);
2441  begin
2442    inherited;
2443    if Length(cboReasons.Text) > 0 then
2444      uReason := cboReasons.Text;
2445  end;
2446  
2447  procedure TfrmODBBank.cboReasonsExit(Sender: TObject);
2448  begin
2449    inherited;
2450    if Length(cboReasons.Text) > 0 then
2451      uReason := cboReasons.Text;
2452  end;
2453  
2454  procedure TfrmODBBank.cboAvailTestSelect(Sender: TObject);
2455  var
2456    i: integer;
2457    ListItem: TListItem;
2458    aCollTime,aTypeScreen,aStr,aModifier,aSpecimen,aSpecimenUID,aSpecimenReq,aTestYes,x,aName,aTNSString, aUrgText: string;
2459    aList: TStringList;
2460    curAdd,aTNS: Integer;
2461    sub,sub1: string;
2462    aChanging: Boolean;
2463  begin
2464    if cboAvailTest.ItemID = '' then Exit;
2465    aList := TStringList.Create;
2466    aChanging := changing;
2467    try
2468      ALabTest := nil;
2469      aTypeScreen := '';
2470      aSpecimen := '';
2471      aSpecimenUID := '';
2472      aSpecimenReq := '';
2473      aTestYes := '1';
2474      aModifier := '';
2475      changing := true;
2476      tQuantity.Text := '';
2477      changing := aChanging;
2478      sub1 := '';
2479      cboModifiers.ItemIndex := -1;
2480      DisableComponentControls;
2481      EnableDiagTestControls;
2482      LRORDERMODE := TORDER_MODE_DIAG;
2483      ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses);
2484      sub := GetSubtype(ALabTest.TestName);
2485      {if not(FOrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK]) then
2486        DetermineCollectionDefaults(Responses); }
2487      DetermineCollectionDefaults(Responses);
2488      with cboAvailTest do
2489        begin
2490          if (Length(ItemID) = 0) or (ItemID = '0') then
2491            begin
2492              changing := aChanging;
2493              Exit;
2494            end;
2495          FLastLabID := ItemID ;
2496          FLastItemID := ItemID;
2497          for i := 0 to uSelectedItems.Count - 1 do
2498            if ItemID = piece(uSelectedItems[i],'^',2) then
2499              begin
2500                ItemIndex := -1;
2501                lvSelectionList.Items[i].Selected := true;
2502                lvSelectionListClick(self);
2503                changing := aChanging;
2504                Exit;
2505              end;
2506          ExtractTypeScreen(aList, uVBECList);
2507          if aList.Count > 0 then aTypeScreen := aList[0];
2508          aList.Clear;
2509          aTNSString := '';
2510          if (Changing = false) and (StrToInt(aTypeScreen) = cboAvailTest.ItemID) and (uTNSOrders.Count > 0) then
2511            begin
2512              for i := 0 to uTNSOrders.Count - 1 do
2513                aTNSString := aTNSString + CRLF + uTNSOrders[i];
2514              with Application do
2515                begin
2516                  NormalizeTopMosts;
2517                  aTNS :=
2518                    MessageBox(PChar(aTNSString + CRLF + CRLF +
2519                     'Do you wish to cancel this request for Type & Screen?'),
2520                     PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'),
2521                     MB_YESNO);
2522                  RestoreTopMosts;
2523                  if aTNS = 6 then
2524                    begin
2525                      cboAvailTest.ItemIndex := -1;
2526                      exit;
2527                    end;
2528                end;
2529            end;
2530          if sub = 't' then with ALabTest do      //DIAGNOSTIC TEST
2531            begin
2532              if ObtainCollSamp then
2533                begin
2534                //For BloodBank orders, this condition should never occur
2535                end
2536              else
2537                begin
2538                  with ALabTest do
2539                    with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
2540                      begin
2541                        x := '' ;
2542                        for i := 0 to WardComment.Count-1 do
2543                        x := x + WardComment.strings[i]+#13#10 ;
2544                        pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
2545                        OrderMessage(x) ;
2546                      end ;
2547                end;
2548          end;
2549        end;
2550      if LRORDERMODE = TORDER_MODE_DIAG then
2551        begin
2552          if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
2553          if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
2554          else if changing = false then
2555            begin
2556              for i := 0 to cboUrgency.Items.Count - 1 do
2557                begin
2558                  aUrgText := cboUrgency.Items[i];
2559                  if aUrgText = '9^ROUTINE' then    // Find urgency default of ROUTINE
2560                    begin
2561                      cboUrgency.ItemIndex := i;
2562                      break;
2563                    end;
2564                end;
2565              Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
2566            end;
2567          if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
2568          if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
2569          with cboCollTime do
2570  
2571          if cboCollType.ItemID = 'LC' then
2572            begin
2573              with cboCollTime do
2574                if Length(ItemID) > 0 then
2575                  begin
2576                    Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
2577                    FLastLabCollTime := ItemID + U + Text;
2578                  end
2579                else if Length(Text) > 0 then
2580                  begin
2581                    Responses.Update('START', 1, ValidCollTime(Text), Text) ;
2582                    FLastLabCollTime := ValidCollTime(Text);
2583                  end;
2584            end
2585          else
2586            begin
2587              with calCollTime do
2588                if FMDateTime > 0 then
2589                  begin
2590                    Responses.Update('START', 1, ValidCollTime(Text), Text);
2591                    FLastColltime := ValidCollTime(Text);
2592                  end
2593                else
2594                  begin
2595                    Responses.Update('START', 1, '', '') ;
2596                    FLastCollTime := '';
2597                  end;
2598            end;
2599          if Length(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID);
2600        end;
2601      uTestSelected := true;
2602      with lvSelectionList do
2603        begin
2604          ListItem := Items.Add;
2605          ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2);
2606          ListItem.SubItems.Add('');
2607          ListItem.SubItems.Add('');
2608          ListItem.SubItems.Add('');
2609          ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1));
2610          if piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1) = aTypeScreen then
2611            begin
2612              lblTNS.Caption := '';
2613              lblTNS.Visible := false;
2614              memMessage.Text := '';
2615              pnlMessage.Visible := false;
2616              uGetTnS := 0;
2617              pnlDiagnosticTests.Caption := 'Diagnostic Tests';
2618            end;
2619        end;
2620      aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimenReq + '^' + aSpecimen + '^' + aSpecimenUID + '^' + IntToStr(aLabTest.ItemID);
2621      uSelectedItems.Add(aStr);
2622      CurAdd := 1;
2623      for i := 0 to uSelectedItems.Count - 1 do
2624        begin
2625          aName := lvSelectionList.Items[i].Caption;
2626          x := uSelectedItems[i];
2627          if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
2628            begin
2629              if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
2630            end;
2631          Inc(CurAdd);
2632        end;
2633      memOrder.Text := Responses.OrderText;
2634    finally
2635      aList.Free;
2636    end;
2637    if lvSelectionList.Items.Count > 0 then
2638      begin
2639        pnlSelectedTests.Visible := True;
2640        cmdAccept.Visible := True;
2641        memOrder.Visible := True;
2642        GroupBox1.Visible := False;
2643      end;
2644  end;
2645  
2646  procedure TfrmODBBank.cboAvailCompSelect(Sender: TObject);
2647   var
2648    aList,aTests: TStringList;
2649    i,j,k,getTest,TestAdded: integer;
2650    text : string;
2651    aMSBOS,aMSBOSContinue,curAdd,AnInstance: integer;
2652    sub,sub1: string;
2653    ListItem: TListItem;
2654    aTypeScreen,aSpecimen,aSpecimenUID,aSpecimenReq,aTestYes,aStr,aMsg,aModifier,x,x1,aReason,aSurgery,aCollTime,aCollSave,aName,aUrgText: String;
2655    aChanging: Boolean;
2656  begin
2657    if cboAvailComp.ItemID = '' then Exit;
2658    aList := TStringList.Create;
2659    aTests := TStringList.Create;
2660    sub1 := '';
2661    aChanging := changing;
2662    try
2663      DisableDiagTestControls;
2664      EnableComponentControls;
2665      if not(changing = true) then
2666        begin
2667          changing := true;
2668          tQuantity.Text := '';
2669          cboModifiers.ItemIndex := -1;
2670          changing := aChanging;
2671        end;
2672      LRORDERMODE := TORDER_MODE_COMP;
2673      with cboAvailComp do
2674        begin
2675          if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
2676          FLastLabID := ItemID ;
2677          FLastItemID := ItemID;
2678          for i := 0 to uSelectedItems.Count - 1 do
2679            if ItemID = piece(uSelectedItems[i],'^',2) then
2680              begin
2681                ItemIndex := -1;
2682                lvSelectionList.Items[i].Selected := true;
2683                lvSelectionListClick(self);
2684                Exit;
2685              end;
2686          ALabTest := TLabTest.Create(ItemID, Responses);
2687          sub := GetSubtype(ALabTest.TestName);
2688          changing := aChanging;
2689          StatusText('');
2690        end;
2691      aList.Clear;
2692      TestAdded := 0;
2693      getTest := 0;
2694      ExtractTests(aList, uVBECList);   //Get Lab Results associated with ordered components
2695        for j := 0 to aList.Count - 1 do
2696          begin
2697            if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then
2698              begin
2699                if uTestsForResults.Count < 1 then getTest := 1;
2700                for k := 0 to uTestsForResults.Count - 1 do
2701                  begin
2702                    if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then
2703                      begin
2704                        getTest := 0;
2705                        break;
2706                      end
2707                    else getTest := 1;
2708                  end;
2709                if getTest = 1 then
2710                  begin
2711                    uTestsForResults.Add(piece(aList[j],'^',3));
2712                    TestAdded := 1;
2713                  end;
2714              end;
2715          end;
2716        if TestAdded = 1 then
2717          begin
2718            aTests.Clear;
2719            GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults);
2720            if aTests.Count > 0 then
2721              begin
2722                edtResults.Clear;
2723                QuickCopy(ATests,edtResults);
2724                TabResults.Caption := 'Lab Results Available';
2725                uRaw.Clear;
2726                GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
2727              end;
2728          end;
2729        CurAdd := 1;
2730        if uRaw.Count > 0 then
2731        for j := 0 to uRaw.Count - 1 do
2732          begin
2733            if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
2734            Inc(CurAdd);
2735          end;
2736      aTypeScreen := '';
2737      aSpecimen := '';
2738      aSpecimenUID := '';
2739      aSpecimenReq := '';
2740      aTestYes := '0';
2741      aReason := '';
2742      aSurgery := '';
2743      aCollTime := '';
2744      aList.Clear;
2745      ExtractTypeScreen(aList, uVBECList);
2746      if aList.Count > 0 then aTypeScreen := aList[0];
2747      aList.Clear;
2748      ExtractSpecimen(aList, uVBECList);
2749      if aList.Count > 0 then
2750        begin
2751          aSpecimen := piece(aList[0], '^', 1);
2752          aSpecimenUID := piece(aList[0], '^', 2);
2753        end;
2754      if (cboSurgery.ItemID = '') and (length(cboSurgery.Text) > 0) then
2755        begin
2756          for i := 0 to cboSurgery.Items.Count - 1 do
2757            if uppercase(cboSurgery.Text) = uppercase(piece(cboSurgery.Items[i],'^',2)) then
2758              begin
2759                cboSurgery.ItemIndex := i;
2760                Break;
2761              end;
2762        end;
2763      if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
2764      if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex];
2765      if length(cboSurgery.ItemID) > 0 then aSurgery := cboSurgery.Items[cboSurgery.ItemIndex];
2766      if (Length(cboSurgery.ItemID) > 0) and (length(tQuantity.Text) > 0) and (strToInt(tQuantity.Text) > 0) then
2767        begin
2768          uChangingMSBOS := true;
2769          cboSurgeryChange(self);
2770          uChangingMSBOS := false;
2771          if cboAvailComp.ItemIndex = -1 then Exit;
2772          aList.Clear;
2773          ExtractMSBOS(aList, uVBECList);    //Get maximum units for selected Surgey
2774          for i := 0 to aList.Count - 1 do
2775            begin
2776              if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
2777               and (uppercase((piece(aList[i],'^',3))) = uppercase(cboSurgery.Text)) then
2778                begin
2779                  aMSBOS := StrToInt(piece(aList[i],'^',4));
2780                  if (aMSBOS > 0) and (Length(tQuantity.Text) > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
2781                    begin
2782                      with Application do
2783                      begin
2784                        NormalizeTopMosts;
2785                        aMSBOSContinue :=
2786                          MessageBox(PChar('The number of units ordered (' + tQuantity.Text +
2787                           ') for ' + aLabTest.TestName + ' Exceeds the maximum number recommended ('
2788                           + IntToStr(aMSBOS) +
2789                           ') for the ' + cboSurgery.text +
2790                           ' surgical procedure.' + CRLF +
2791                           'If you need to order more than the maximum number of units, please enter a justification in the Comment box.'
2792                            + CRLF + CRLF + 'Edit the Blood component Quantity?'),
2793                           PChar('Maximum Number of Units Exceeded'),
2794                           MB_YESNO);
2795                        RestoreTopMosts;
2796                      end;
2797                      if aMSBOSContinue = 6 then
2798                        begin
2799                          ShowMsg(cboAvailComp.Text + ' has NOT been added to this request.');
2800                          exit;
2801                        end;
2802                    end;
2803                end;
2804            end;
2805        end;
2806      if (uTNSOrders.Count < 1) and (SpecimenNeeded(aList, uVBECList, aLabTest.ItemID)) then  //check to see if type and screen is needed CQ 17349
2807        begin
2808          uGetTnS := 1;
2809          for i := 0 to lvSelectionList.Items.Count - 1 do
2810            begin
2811              if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
2812                begin
2813                  uGetTnS := 0;
2814                  if length(cboUrgency.ItemID) > 0 then uDfltUrgency := cboUrgency.ItemID;
2815                  lblTNS.Caption := '';
2816                  lblTNS.Visible := false;
2817                  memMessage.Text := '';
2818                  pnlMessage.Visible := false;
2819                  pnlDiagnosticTests.Caption := 'Diagnostic Tests';
2820                  break;
2821                end;
2822            end;
2823        end;
2824      aList.Clear;
2825      ExtractSpecimens(aList, uVBECList);    //Get specimen values to pass back to Server
2826      for i := 0 to aList.Count - 1 do
2827        begin
2828          if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then
2829            begin
2830              aSpecimenReq := piece(aList[i],'^',2);
2831              if (SpecimenNeeded(aList, uVBECList, aLabTest.ItemID)) then
2832                aSpecimenUID := '';
2833              break;
2834            end;
2835        end;
2836      uComponentSelected := true;
2837      with lvSelectionList do
2838        begin
2839          ListItem := Items.Add;
2840          ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2);
2841          ListItem.SubItems.Add(tQuantity.Text);
2842          if length(cboModifiers.ItemID) > 0 then
2843            begin
2844              ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
2845              ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
2846            end
2847            else
2848              begin
2849                ListItem.SubItems.Add('');
2850                ListItem.SubItems.Add('');
2851              end;
2852          ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
2853        end;
2854        aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimenReq + '^' + aSpecimen + '^' + aSpecimenUID + '^' + IntToStr(aLabTest.ItemID);
2855        uSelectedItems.Add(aStr);
2856        CurAdd := 1;
2857        for i := 0 to uSelectedItems.Count - 1 do
2858          begin
2859            aName := lvSelectionList.Items[i].Caption;
2860            x := uSelectedItems[i];
2861            if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
2862              begin
2863                if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
2864              end
2865            else
2866              begin
2867                if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
2868                if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
2869                if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), piece(x,'^',4));
2870                if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
2871                if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
2872                if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
2873                if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
2874                  else
2875                    begin
2876                      cboUrgency.ItemIndex := 2;
2877                      for j := 0 to cboUrgency.Items.Count - 1 do
2878                        begin
2879                          aUrgText := cboUrgency.Items[j];
2880                          if aUrgText = '9^ROUTINE' then    // Find urgency default of ROUTINE
2881                            begin
2882                              cboUrgency.ItemIndex := i;
2883                              break;
2884                            end;
2885                        end;
2886                      Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
2887                    end;
2888              end;
2889            Inc(CurAdd);
2890          end;
2891        memOrder.Text := Responses.OrderText;
2892    finally
2893      alist.Free;
2894      aTests.Free;
2895    end;
2896    aMsg := '';
2897    LRORDERMODE := TORDER_MODE_INFO;
2898    if uGetTnS = 1 then
2899      begin
2900        lblTNS.Caption := 'TYPE + SCREEN must be added to order';
2901        lblTNS.Visible := true;
2902        memMessage.Text := 'TYPE + SCREEN must be added to order';
2903        pnlMessage.Visible := true;
2904        pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
2905      end
2906      else pnlDiagnosticTests.Caption := 'Diagnostic Tests';
2907    if lvSelectionList.Items.Count > 0 then
2908      begin
2909        pnlSelectedTests.Visible := True;
2910        cmdAccept.Visible := True;
2911        memOrder.Visible := True;
2912        GroupBox1.Visible := False;
2913      end;
2914    if tQuantity.CanFocus = true then tQuantity.SetFocus;
2915  end;
2916  
2917  procedure TfrmODBBank.DisableCommentPanels;
2918  begin
2919    lblReqComment.Visible := False;
2920  end;
2921  
2922  procedure TfrmODBBank.DisableComponentControls;
2923  var
2924    j: integer;
2925  begin
2926    lblQuantity.Enabled := false;
2927    tQuantity.Enabled := false;
2928    lblModifiers.Enabled := false;
2929    cboModifiers.Enabled := false;
2930    lblQuantity.Caption := 'Quantity';
2931    lblWanted.Caption := 'Date/Time Wanted';
2932    lblReason.Caption := 'Reason for Request';
2933    cboAvailComp.ItemIndex := -1;
2934    for j := uSelectedItems.Count - 1 downto 0 do
2935      begin
2936        if piece(uSelectedItems[j],'^',1) = '0' then
2937          begin
2938            lblReason.Caption := 'Reason for Request*';
2939            lblWanted.Caption := 'Date/Time Wanted*';
2940            Break;
2941          end;
2942      end;
2943  end;
2944  
2945  procedure TfrmODBBank.EnableComponentControls;
2946  begin
2947    lblQuantity.Enabled := true;
2948    tQuantity.Enabled := true;
2949    lblModifiers.Enabled := true;
2950    cboModifiers.Enabled := true;
2951    lblQuantity.Caption := 'Quantity*';
2952    lblWanted.Caption := 'Date/Time Wanted*';
2953    lblReason.Caption := 'Reason for Request*';
2954    if not(changing) then
2955      if not(uSelUrgency = 'PRE-OP') then
2956        if uSelUrgency = '' then
2957          if lvSelectionList.Items.Count < 1 then
2958            cboUrgency.SelectByID(IntToStr(uDfltUrgency));
2959    if cboUrgency.Text = 'PRE-OP' then
2960          begin
2961            lblSurgery.Enabled := true;
2962            cboSurgery.Enabled := true;
2963            lblSurgery.Caption := 'Surgery*';
2964          end
2965        else
2966          begin
2967            if Length(cboSurgery.Text) > 0 then
2968              begin
2969                lblSurgery.Enabled := true;
2970                cboSurgery.Enabled := true;
2971                lblSurgery.Caption := 'Surgery*';
2972              end
2973              else
2974              begin
2975                lblSurgery.Enabled := false;
2976                cboSurgery.Enabled := false;
2977                lblSurgery.Caption := 'Surgery';
2978                cboSurgery.ItemIndex := -1;
2979                Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
2980              end;
2981          end;
2982  
2983    lblDiagComment.Enabled := true;
2984  end;
2985  
2986  procedure TfrmODBBank.DisableDiagTestControls;
2987  var
2988    i,j: integer;
2989    diagflg: boolean;
2990  begin
2991    diagflg := false;
2992    for i := 0 to uSelectedItems.Count - 1 do
2993      begin
2994        if (piece(uSelectedItems[i],'^',1) = '1') then
2995          begin
2996            diagflg := true;
2997            Break;
2998          end;
2999      end;
3000    if diagflg = false then
3001      begin
3002        lblCollTime.Enabled := false;
3003        calCollTime.Enabled := false;
3004        cboCollTime.Enabled := false;
3005        lblCollType.Enabled := false;
3006        cboCollType.Enabled := false;
3007        cmdImmedColl.Enabled := false;
3008      end;
3009    lblCollTime.Caption := 'Collection Date/Time';
3010    lblCollType.Caption := 'Collection Type';
3011    cboAvailTest.ItemIndex := -1;
3012    for j := uSelectedItems.Count - 1 downto 0 do
3013      begin
3014        if piece(uSelectedItems[j],'^',1) = '1' then
3015          begin
3016            lblCollTime.Caption := 'Collection Date/Time*';
3017            lblCollType.Caption := 'Collection Type*';
3018            Break;
3019          end;
3020      end;
3021  end;
3022  
3023  procedure TfrmODBBank.EnableDiagTestControls;
3024  begin
3025    lblCollTime.Enabled := true;
3026    calCollTime.Enabled := true;
3027    cboCollTime.Enabled := true;
3028    lblCollType.Enabled := true;
3029    cboCollType.Enabled := true;
3030    cmdImmedColl.Enabled := true;
3031    lblCollTime.Caption := 'Collection Date/Time*';
3032    lblCollType.Caption := 'Collection Type*';
3033    if not(changing) then
3034      if not(uSelUrgency = 'PRE-OP') then
3035        if uSelUrgency = '' then
3036          if lvSelectionList.Items.Count < 1 then
3037            cboUrgency.SelectByID(IntToStr(uDfltUrgency));
3038  end;
3039  
3040  procedure TfrmODBBank.LoadRequiredComment(CmtType: integer);
3041  begin
3042    DisableCommentPanels;
3043    lblReqComment.Visible := True ;
3044  end;
3045  
3046  procedure TfrmODBBank.DetermineCollectionDefaults(Responses: TResponses);
3047  var
3048    RespCollect, RespStart: TResponse;
3049  begin
3050    if ALabTest = nil then exit;
3051    calCollTime.Enabled := True;
3052    lblCollTime.Enabled := True;
3053    cboColltime.Enabled := True;
3054    with Responses, ALabTest do
3055      begin
3056        RespCollect := FindResponseByName('COLLECT',1);
3057        RespStart   := FindResponseByName('START'  ,1);
3058        if (RespCollect <> nil) then with RespCollect do
3059          begin
3060            if IValue = 'LC' then
3061              begin
3062                if not LabCanCollect then
3063                  begin
3064                   cboCollType.SelectByID('WC');
3065                   SetupCollTimes('WC');
3066                  end
3067                else   //  if LabCanCollect
3068                  begin
3069                   cboCollType.SelectByID('LC');
3070                   SetupCollTimes('LC');
3071                   CtrlInits.SetControl(cboCollTime, 'Lab Collection Times') ;
3072                   if RespStart <> nil then
3073                     begin
3074                       cboCollTime.SelectByID('L' + RespStart.IValue);
3075                       if cboCollTime.ItemIndex < 0 then
3076                         cboCollTime.Text := RespStart.IValue;
3077                     end;
3078                  end;
3079              end
3080            else    //  if IValue <> 'LC'
3081              begin
3082                cboCollType.SelectByID(IValue) ;
3083                SetupCollTimes(IValue);
3084                if RespStart <> nil then
3085                  begin
3086                    if ContainsAlpha(RespStart.IValue) then
3087                      calColltime.Text := RespStart.IValue
3088                    else
3089                      calColltime.FMDateTime := StrToFMDateTime(RespStart.IValue);
3090                  end;
3091              end ;
3092            if IValue = 'I' then
3093              if not LabCanCollect then
3094                begin
3095                 cboCollType.SelectByID('WC');
3096                 SetupCollTimes('WC');
3097                end
3098              else
3099                begin
3100                  calCollTime.Enabled := False;
3101                  cboCollType.SelectByID('I');
3102                  SetupCollTimes('I');
3103                  //cboCollTypeClick(self);
3104                  //txtImmedColl.Enabled := True;
3105                  if RespStart <> nil then
3106                    begin
3107                      txtImmedColl.Text := RespStart.EValue;
3108                    end;
3109                end;
3110          end
3111        else   // if (RespCollect = nil)
3112          LoadCollType(cbocollType);
3113      end;
3114  end;
3115  
3116  procedure TfrmODBBank.cboAvailTestEnter(Sender: TObject);
3117  var
3118    j: integer;
3119  begin
3120    inherited;
3121    if Length(cboAvailTest.Text) > 0 then Exit;
3122    for j := uSelectedItems.Count - 1 downto 0 do
3123      begin
3124        if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '1') then
3125          begin
3126            lvSelectionList.Items[j].Selected := true;
3127            lvSelectionListClick(self);
3128            Break;
3129          end;
3130      end;
3131  end;
3132  
3133  procedure TfrmODBBank.cboAvailTestExit(Sender: TObject);
3134  begin
3135    inherited;
3136    if (Length(cboAvailTest.Text)>0) and (Length(cboAvailTest.ItemID) = 0) or (cboAvailTest.ItemID = '0') then
3137      begin
3138        ShowMsg('Invalid Test Selection. Please select a valid Test.');
3139        cboAvailTestSelect(cboAvailTest);
3140        cboAvailTest.SetFocus;
3141        Exit;
3142      end;
3143    if cboAvailTest.ItemID = FLastLabID then Exit;
3144    if not (Length(cboAvailTest.ItemID) = 0) then cboAvailTestSelect(cboAvailTest);
3145  end;
3146  
3147  procedure TfrmODBBank.cboAvailCompEnter(Sender: TObject);
3148  var
3149    j: integer;
3150  begin
3151    inherited;
3152    if Length(cboAvailComp.Text) > 0 then Exit;
3153    for j := uSelectedItems.Count - 1 downto 0 do
3154      begin
3155        if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '0') then
3156          begin
3157            lvSelectionList.Items[j].Selected := true;
3158            lvSelectionListClick(self);
3159            Break;
3160          end;
3161      end;
3162  end;
3163  
3164  procedure TfrmODBBank.cboAvailCompExit(Sender: TObject);
3165  begin
3166    inherited;
3167    if (Length(cboAvailComp.Text)>0) and (Length(cboAvailComp.ItemID) = 0) or (cboAvailComp.ItemID = '0') then
3168      begin
3169        ShowMsg('Invalid Component selection. Please select a valid Component.');
3170        cboAvailCompSelect(cboAvailComp);
3171        cboAvailComp.SetFocus;
3172        Exit;
3173      end;
3174    if cboAvailComp.ItemID = FLastLabID then Exit;
3175    if not (Length(cboAvailComp.ItemID) = 0) then cboAvailCompSelect(cboAvailComp);
3176  end;
3177  
3178  procedure TfrmODBBank.cboAvailTestNeedData(Sender: TObject;
3179    const StartFrom: String; Direction, InsertAt: Integer);
3180  begin
3181    cboAvailTest.ForDataUse(SubSetOfOrderItems(StartFrom, Direction, FVbecLookup));
3182  end;
3183  
3184  procedure TfrmODBBank.cboAvailCompNeedData(Sender: TObject;
3185    const StartFrom: String; Direction, InsertAt: Integer);
3186  begin
3187    cboAvailComp.ForDataUse(SubSetOfOrderItems(StartFrom, Direction, FVbecLookup));
3188  end;
3189  
3190  procedure TfrmODBBank.cmdImmedCollClick(Sender: TObject);
3191  var
3192    ImmedCollTime: string;
3193  begin
3194    inherited;
3195    ImmedCollTime := SelectImmediateCollectTime(Font.Size, txtImmedColl.Text);
3196    if ImmedCollTime <> '-1' then
3197      begin
3198        txtImmedColl.Text := ImmedCollTime;
3199        calCollTime.FMDateTime := StrToFMDateTime(ImmedCollTime);
3200      end
3201    else
3202      begin
3203        txtImmedColl.Clear;
3204        calCollTime.Clear;
3205      end;
3206  end;
3207  
3208  procedure TfrmODBBank.pgeProductChange(Sender: TObject);
3209  begin
3210    inherited;
3211    case pgeProduct.TabIndex of
3212    TI_COMPONENT :     begin
3213                    memOrder.Visible := true;
3214                    cmdAccept.Visible := true;
3215                    pnlSelectedTests.Visible := true;
3216                    lvSelectionList.Width := lvSelectionList.Width + 1; //added to fix font resize issue - funky column display
3217                  end;
3218    TI_INFO :     begin
3219                    if lvSelectionList.Items.Count > 0 then
3220                    begin
3221                      memOrder.Visible := true;
3222                      cmdAccept.Visible := true;
3223                      pnlSelectedTests.Visible := true;
3224                    end
3225                    else
3226                    begin
3227                      memOrder.Visible := false;
3228                      cmdAccept.Visible := false;
3229                      pnlSelectedTests.Visible := false;
3230                    end;
3231                  end;
3232    TI_RESULTS :  begin
3233                    if lvSelectionList.Items.Count > 0 then
3234                    begin
3235                      memOrder.Visible := true;
3236                      cmdAccept.Visible := true;
3237                      pnlSelectedTests.Visible := true;
3238                    end
3239                    else
3240                    begin
3241                      memOrder.Visible := false;
3242                      cmdAccept.Visible := false;
3243                      pnlSelectedTests.Visible := false;
3244                    end;
3245                  end;
3246    end; {case}
3247  end;
3248  
3249  procedure TfrmODBBank.pnlBloodComponentsClick(Sender: TObject);
3250  begin
3251    inherited;
3252    cboAvailComp.SetFocus;
3253  end;
3254  
3255  procedure TfrmODBBank.pnlBloodComponentsEnter(Sender: TObject);
3256  begin
3257    inherited;
3258    pnlBloodComponents.Color := clActiveborder;
3259  end;
3260  
3261  procedure TfrmODBBank.pnlBloodComponentsExit(Sender: TObject);
3262  begin
3263    inherited;
3264    pnlBloodcomponents.Color := clBtnFace;
3265  end;
3266  
3267  procedure TfrmODBBank.pnlDiagnosticTestsClick(Sender: TObject);
3268  begin
3269    inherited;
3270    cboAvailTest.SetFocus;
3271  end;
3272  
3273  procedure TfrmODBBank.pnlDiagnosticTestsEnter(Sender: TObject);
3274  begin
3275    inherited;
3276    pnlDiagnosticTests.Color := clActiveBorder;
3277  end;
3278  
3279  procedure TfrmODBBank.pnlDiagnosticTestsExit(Sender: TObject);
3280  begin
3281    inherited;
3282    pnlDiagnosticTests.Color := clBtnFace;
3283  end;
3284  
3285  procedure TfrmODBBank.cboCollTimeChange(Sender: TObject);
3286  var
3287    CollType: string;
3288  const
3289    TX_BAD_TIME         = ' is not a routine lab collection time.' ;
3290    TX_BAD_TIME_CAP     = 'Invalid Time';
3291  begin
3292    CollType := 'LC';
3293    with cboCollTime do
3294      begin
3295        if ItemID = 'LO' then
3296          begin
3297            ItemIndex := -1;
3298            Text := GetFutureLabTime(FMToday);
3299          end;
3300      end;
3301    cboCollType.SelectByID(CollType);
3302    if uSelectedItems.Count > 0 then
3303      begin
3304        with cboCollTime do
3305          if Length(ItemID) > 0 then
3306            begin
3307              Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
3308              FLastLabCollTime := ItemID + U + Text;
3309            end
3310          else if Length(Text) > 0 then
3311            begin
3312              Responses.Update('START', 1, ValidCollTime(Text), Text) ;
3313              FLastLabCollTime := ValidCollTime(Text);
3314            end;
3315      end;
3316  end;
3317  
3318  procedure TfrmODBBank.cboCollTimeEnter(Sender: TObject);
3319  var
3320    j: integer;
3321  begin
3322    inherited;
3323    if Length(cboAvailTest.Text) > 0 then Exit;
3324    for j := uSelectedItems.Count - 1 downto 0 do
3325      begin
3326        if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '1') then
3327          begin
3328            lvSelectionList.Items[j].Selected := true;
3329            lvSelectionListClick(self);
3330            Break;
3331          end;
3332      end;
3333  end;
3334  
3335  procedure TfrmODBBank.cboCollTypeChange(Sender: TObject);
3336  begin
3337    if (ALabTest = nil) or Changing or (cboCollType.ItemID = '') then exit;
3338    if (cboCollType.ItemID = 'I') and (not ALabTest.LabCanCollect) then
3339      begin
3340        InfoBox(TX_NO_IMMED, TX_NO_IMMED_CAP, MB_OK or MB_ICONWARNING);
3341        cboCollType.ItemIndex := -1;
3342        Exit;
3343      end;
3344    if cboCollType.ItemID = 'I' then
3345    begin
3346      cboCollTime.ItemIndex := -1;
3347      cboCollTime.Text := 'NOW';
3348      calCollTime.Text := 'NOW';
3349    end;
3350    SetupCollTimes(cboCollType.ItemID);
3351    if Length(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID);
3352    calCollTimeChange(self);
3353  end;
3354  
3355  procedure TfrmODBBank.cboCollTypeClick(Sender: TObject);
3356  begin
3357    inherited;
3358    FOrderAction := 0;
3359  end;
3360  
3361  procedure TfrmODBBank.cboCollTypeEnter(Sender: TObject);
3362  var
3363    j: integer;
3364  begin
3365    inherited;
3366    if Length(cboAvailTest.Text) > 0 then Exit;
3367    for j := uSelectedItems.Count - 1 downto 0 do
3368      begin
3369        if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '1') then
3370          begin
3371            lvSelectionList.Items[j].Selected := true;
3372            lvSelectionListClick(self);
3373            Break;
3374          end;
3375      end;
3376  end;
3377  
3378  procedure TfrmODBBank.cboModifiersChange(Sender: TObject);
3379  var
3380    i: integer;
3381    ListItem: TListItem;
3382    x,q,m: string;
3383  begin
3384    inherited;
3385    if changing = true then Exit;
3386    if (cboAvailComp.ItemIndex <> -1) and (uSelectedItems.Count > 0) then
3387      begin
3388        for i := 0 to lvSelectionList.Items.Count - 1 do
3389          begin
3390            x := uSelectedItems[i];
3391            m := piece(x,'^',4);
3392            q := piece(x,'^',3);
3393            if lvSelectionList.Items[i].Caption = piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2) then
3394              begin
3395                ListItem := lvSelectionList.Items[i];
3396                ListItem.SubItems.Clear;
3397                ListItem.SubItems.Add(q);
3398                if length(cboModifiers.ItemID) > 0 then
3399                  begin
3400                    ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
3401                    ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
3402                  end
3403                  else
3404                    begin
3405                      ListItem.SubItems.Add('');
3406                      ListItem.SubItems.Add('');
3407                    end;
3408                ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
3409                Responses.Update('MODIFIER', (i+1), cboModifiers.Text, cboModifiers.Text);
3410                Break;
3411              end;
3412          end;
3413      end;
3414    if Length(cboModifiers.Text) > 0 then
3415      begin
3416        memOrder.Text := Responses.OrderText;
3417      end;
3418  end;
3419  
3420  procedure TfrmODBBank.cboModifiersEnter(Sender: TObject);
3421  var
3422    j: integer;
3423  begin
3424    inherited;
3425    if Length(cboAvailComp.Text) > 0 then Exit;
3426    for j := uSelectedItems.Count - 1 downto 0 do
3427      begin
3428        if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '0') then
3429          begin
3430            lvSelectionList.Items[j].Selected := true;
3431            lvSelectionListClick(self);
3432            Break;
3433          end;
3434      end;
3435  end;
3436  
3437  procedure TfrmODBBank.LoadModifiers(AComboBox:TORComboBox);
3438  var
3439    i: integer;
3440  begin
3441    with AComboBox do
3442      begin
3443        Clear;
3444        for i := 0 to uModifierList.Count - 1 do
3445             Items.Add(uModifierList[i]);
3446      end;
3447  end;
3448  
3449  procedure TfrmODBBank.LoadReasons(AComboBox:TORComboBox);
3450  var
3451    i: integer;
3452  begin
3453    with AComboBox do
3454      begin
3455        Clear;
3456        for i := 0 to uReasonsList.Count - 1 do
3457             Items.Add(uReasonsList[i]);
3458      end;
3459  end;
3460  
3461  procedure TfrmODBBank.LoadUrgencies(AComboBox:TORComboBox);
3462  var
3463    i: integer;
3464  begin
3465    with AComboBox do
3466      begin
3467        Clear;
3468        {for i := 0 to uUrgencyList.Count - 1 do
3469           if (piece(uUrgencyList[i],'^',2) = 'STAT') and (StatAllowed(Patient.DFN) = false) then
3470             Continue
3471           else
3472             Items.Add(uUrgencyList[i]); }
3473        for i := 0 to uUrgencyList.Count - 1 do
3474          Items.Add(uUrgencyList[i]);
3475