1 | unit UBAGlobals;
|
---|
2 |
|
---|
3 | {$OPTIMIZATION OFF}
|
---|
4 |
|
---|
5 | {$define debug}
|
---|
6 |
|
---|
7 | interface
|
---|
8 |
|
---|
9 | uses
|
---|
10 | Classes, ORNet, uConst, ORFn, Sysutils, Dialogs, Windows,Messages, rOrders;
|
---|
11 |
|
---|
12 | type
|
---|
13 |
|
---|
14 | {Problem List Record Used To Add New DX From SignOrders Form }
|
---|
15 | TBAPLRec = class(TObject)
|
---|
16 | constructor Create(PLlist:TStringList);
|
---|
17 | function BuildProblemListDxEntry(pDxCode:string):TStringList;
|
---|
18 | function FMToDateTime(FMDateTime: string): TDateTime;
|
---|
19 |
|
---|
20 | end;
|
---|
21 |
|
---|
22 | {patient qualifiers}
|
---|
23 | TBAPLPt=class(TObject)
|
---|
24 | PtVAMC:string;
|
---|
25 | PtDead:string;
|
---|
26 | PtBid:string;
|
---|
27 | PtServiceConnected:boolean;
|
---|
28 | PtAgentOrange:boolean;
|
---|
29 | PtRadiation:boolean;
|
---|
30 | PtEnvironmental:boolean;
|
---|
31 | PtHNC:boolean;
|
---|
32 | PtMST:boolean;
|
---|
33 | PtSHAD:boolean;
|
---|
34 | constructor Create(Alist:TStringList);
|
---|
35 | function GetGMPDFN(dfn:string;name:String):string;
|
---|
36 | public
|
---|
37 | function rpcInitPt(const PatientDFN: string): TStrings ;
|
---|
38 | procedure LoadPatientParams(AList:TstringList);
|
---|
39 |
|
---|
40 | end;
|
---|
41 |
|
---|
42 | TBAGlobals = class(TObject)
|
---|
43 | private
|
---|
44 | FOrderNum: string;
|
---|
45 | protected
|
---|
46 | public
|
---|
47 | constructor Create;
|
---|
48 | published
|
---|
49 | property OrderNum: string read FOrderNum write FOrderNum;
|
---|
50 | procedure AddBAPCEDiag(DiagStr:string);
|
---|
51 | procedure ClearBAPCEDiagList;
|
---|
52 | end;
|
---|
53 |
|
---|
54 | TBADxRecord = class(TObject)
|
---|
55 | FExistingRecordID: string;
|
---|
56 | FOrderID: string;
|
---|
57 | FBADxCode: string; //Primary Dx
|
---|
58 | FBASecDx1: string; //Secondary Dx 1
|
---|
59 | FBASecDx2: string; //Secondary Dx 2
|
---|
60 | FBASecDx3: string; //Secondary Dx 3
|
---|
61 | FDxDescCode: string;
|
---|
62 | FDxDesc1: string;
|
---|
63 | FDxDesc2: string;
|
---|
64 | FDxDesc3: string;
|
---|
65 | FTreatmentFactors: string;
|
---|
66 | end;
|
---|
67 |
|
---|
68 | TBACopiedOrderFlags = class
|
---|
69 | OrderID: string;
|
---|
70 | end;
|
---|
71 |
|
---|
72 | TBATreatmentFactorsInRec = class(TObject)
|
---|
73 | FBAOrderID: string;
|
---|
74 | FBAEligible: string;
|
---|
75 | FBATFactors: string;
|
---|
76 | end;
|
---|
77 |
|
---|
78 | TBAUnsignedBillingRec = class(TObject)
|
---|
79 | FBAOrderID: string;
|
---|
80 | FBASTSFlags: string;
|
---|
81 | FBADxCode: string;
|
---|
82 | FBASecDx1: string;
|
---|
83 | FBASecDx2: string;
|
---|
84 | FBASecDx3: string;
|
---|
85 | end;
|
---|
86 |
|
---|
87 | TBAConsultOrderRec = class(TObject)
|
---|
88 | FBAOrderID: string;
|
---|
89 | FBADxCode: string;
|
---|
90 | FBASecDx1: string;
|
---|
91 | FBASecDx2: string;
|
---|
92 | FBASecDx3: string;
|
---|
93 | FBATreatmentFactors: string;
|
---|
94 | end;
|
---|
95 |
|
---|
96 | TBAClearedBillingRec = class(TObject)
|
---|
97 | FBAOrderID: string;
|
---|
98 | FBASTSFlags: string;
|
---|
99 | FBADxCode: string;
|
---|
100 | FBASecDx1: string;
|
---|
101 | FBASecDx2: string;
|
---|
102 | FBASecDx3: string;
|
---|
103 | end;
|
---|
104 |
|
---|
105 | TBAFactorsRec = class(TObject)
|
---|
106 | FBAFactorActive : boolean;
|
---|
107 | FBAFactorSC : string;
|
---|
108 | FBAFactorMST : string;
|
---|
109 | FBAFactorAO : string;
|
---|
110 | FBAFactorIR : string;
|
---|
111 | FBAFactorEC : string;
|
---|
112 | FBAFactorHNC : string;
|
---|
113 | FBAFactorCV : string;
|
---|
114 | FBAFactorSHAD : string;
|
---|
115 | end;
|
---|
116 |
|
---|
117 | TBAPLFactorsIN = class(TOBject)
|
---|
118 | FPatientID : string; // UProblems.piece 1
|
---|
119 | FBADxText : string; // UProblems.piece 2
|
---|
120 | FBADxCode : string; // UProblems.piece 3
|
---|
121 | FBASC : string; // UProblems.piece 5
|
---|
122 | FBASC_YN : string; // UProblems.piece 6
|
---|
123 | FBATreatFactors : string; //(......)
|
---|
124 | end;
|
---|
125 |
|
---|
126 | TBACBStsFlagsIN = class(TOBject) // Y/N/U
|
---|
127 | CB_Sts_Flags :string;
|
---|
128 | // CB_SC :string;
|
---|
129 | CB_AO :string;
|
---|
130 | CB_IR :string;
|
---|
131 | CB_EC :string;
|
---|
132 | CB_MST :string;
|
---|
133 | CB_HNC :string;
|
---|
134 | CB_CV :string;
|
---|
135 | CB_SHAD :string;
|
---|
136 | end;
|
---|
137 |
|
---|
138 | procedure PutBADxListForOrder(var thisRecord: TBADxRecord; thisOrderID: string); //BAPHII 1.3.1
|
---|
139 | procedure CopyDxRecord(sourceOrderID: string; targetOrderID: string); //BAPHII 1.3.1
|
---|
140 | function GetPrimaryDx(thisOrderID: string) : string; //BAPHII 1.3.1
|
---|
141 | function tempDxNodeExists(thisOrderID: string) : boolean;
|
---|
142 | function GetDxNodeIndex(thisOrderID: string) : smallint;
|
---|
143 | function DiagnosesMatch(var List1: TStringList; var List2: TStringList) : boolean;
|
---|
144 | function CountSelectedOrders(const Caller: smallint) : smallint;
|
---|
145 | function CompareOrderDx(const Caller: smallint) : boolean;
|
---|
146 | procedure GetBADxListForOrder(var thisRetVal: TBADxRecord; thisOrderID: string);
|
---|
147 | procedure DestroyDxList;
|
---|
148 | procedure SetBADxList;
|
---|
149 | procedure SimpleAddTempDxList(thisOrderID: string);
|
---|
150 | procedure SetBADxListForOrder(thisRec: TBADxRecord; thisOrderID: string);
|
---|
151 | function AllSelectedDxBlank(const Caller: smallint) : boolean;
|
---|
152 | function SecondaryDxFull(thisOrderID: string) : boolean;
|
---|
153 | procedure AddSecondaryDx(thisOrderID: string; thisDxCode: string);
|
---|
154 | procedure InitializeNewDxRec(var thisDxRec: TBADxRecord);
|
---|
155 | procedure InitializeConsultOrderRec(var thisDxRec: TBAConsultOrderRec);
|
---|
156 | procedure InitializeUnsignedOrderRec(var thisUnsignedRec: TBAUnsignedBillingRec);
|
---|
157 | procedure InitializeTFactorsInRec(var thisTFactorsRecIn: TBATreatmentFactorsInRec);
|
---|
158 | procedure BACopyOrder(sourceOrderList: TStringList); //BAPHII 1.3.2
|
---|
159 | procedure CopyTreatmentFactorsDxsToCopiedOrder(pSourceOrderID:string; pTargetOrderID:string); //BAPHII 1.3.2
|
---|
160 | procedure CopyTreatmentFactorsDxsToRenewedOrder; //BAPHII 1.3.2
|
---|
161 | function GetTFCIForOrder(thisIndex: integer) : string; //BAPHII 1.3.2
|
---|
162 | procedure CopyTFCIToTargetOrder(thisTargetOrderID: string; thisCheckBoxStatus: string);
|
---|
163 |
|
---|
164 | procedure ResetOrderID(fromID: string; toID: string);
|
---|
165 | procedure RemoveOrderFromDxList(thisOrderID: string);
|
---|
166 | function IsUserNurseProvider(pUserID: int64): boolean;
|
---|
167 | function GetPatientTFactors(pOrderList:TStringList): String;
|
---|
168 |
|
---|
169 | var
|
---|
170 | BAGlobals : TBAGlobals;
|
---|
171 | BAPLPt : TBAPLPt;
|
---|
172 | BAPLRec : TBAPLRec;
|
---|
173 | PLlist : TStringList;
|
---|
174 | BADiagnosisList : TStringList;
|
---|
175 | BALocation : integer;
|
---|
176 | BAPCEDiagList : TStringList;
|
---|
177 | BAOrderIDList : TStringList;
|
---|
178 | tempDxList : TList;
|
---|
179 | globalDxRec : TBADxRecord;
|
---|
180 | UnsignedBillingRec : TBAUnsignedBillingRec;
|
---|
181 | ClearedBillingRec : TBAClearedBillingRec;
|
---|
182 | ConsultOrderRec : TBAConsultOrderRec;
|
---|
183 | BAFactorsInRec : TBATreatmentFactorsInRec;
|
---|
184 | BAFactorsRec : TBAFactorsRec;
|
---|
185 | BAOrderList : TStringList;
|
---|
186 | UpdatedBAOrderList: TStringList;
|
---|
187 | ChangeItemOrderNum: string;
|
---|
188 | i : integer;
|
---|
189 | OrderIDList : TStringList;
|
---|
190 | OrderBillableList : TStrings;
|
---|
191 | BAOrderID : string;
|
---|
192 | BILLING_AWARE : boolean;
|
---|
193 |
|
---|
194 | BAtmpOrderList : TStringList;
|
---|
195 | BAFlagsIN : string;
|
---|
196 | BAFlagsOUT : TStringList;
|
---|
197 |
|
---|
198 | SourceOrderID : string; //BAPHII 1.3.2
|
---|
199 | TargetOrderID : string; //BAPHII 1.3.2
|
---|
200 | BACopiedOrderFlags: TStringList; //BAPHII 1.3.2
|
---|
201 | BANurseConsultOrders: TStringList;
|
---|
202 |
|
---|
203 | // Used to display Dx's on fordersSign and fReview grids
|
---|
204 | Dx1 : string;
|
---|
205 | Dx2 : string;
|
---|
206 | Dx3 : string;
|
---|
207 | Dx4 : string;
|
---|
208 | TFactors : string;
|
---|
209 | SC,AO,IR : string;
|
---|
210 | MST,HNC,CV,SHD,EC : string;
|
---|
211 | PLFactorsIndexes : TStringList;
|
---|
212 | BAHoldPrimaryDx : string; // used to verify primart dx has been changed.
|
---|
213 | BAPrimaryDxChanged: boolean;
|
---|
214 | NonBillableOrderList : TStringList; // contains reference to those selected orders that are non billable
|
---|
215 | OrderListSCEI : TSTringList; // OrderID Exists SCEI are required.
|
---|
216 | UnsignedOrders : TStringList; // List of Orders from fReview when "don't sign" action
|
---|
217 | BAUnSignedOrders : TStringList; // OrderID^StsFlags ie., 12345^NNNNNNN
|
---|
218 | BATFHints : TStringList;
|
---|
219 | BASelectedList : TStringList; // contains list of orders selected for signature.
|
---|
220 | BAConsultDxList: TStringList; // contains dx^code^DxRequired(consults Only) selected for consults.
|
---|
221 | BAConsultPLFlags: TStringList; // orderid^flags contains TF's if dx is selected from Problem list and Problem had TF associated.
|
---|
222 | BAFWarningShown: boolean; // flag used to determine if Inactive ICD Code has been shown.
|
---|
223 | BAPersonalDX: boolean;
|
---|
224 | BADeltedOrders: TStringList;
|
---|
225 |
|
---|
226 | implementation
|
---|
227 |
|
---|
228 | uses fBALocalDiagnoses, fOrdersSign, fReview, uCore, rCore, rPCE,uPCE, UBAConst, UBAMessages, UBACore,
|
---|
229 | VAUtils;
|
---|
230 |
|
---|
231 | procedure RemoveOrderFromDxList(thisOrderID: string);
|
---|
232 | {
|
---|
233 | This routine written for CQ4589. Called from fOrdersDC.ExecuteDCOrders().
|
---|
234 | }
|
---|
235 | var
|
---|
236 | i: integer;
|
---|
237 | begin
|
---|
238 | if tempDxList.Count > 0 then
|
---|
239 | for i := 0 to tempDxList.Count-1 do
|
---|
240 | if tempDxNodeExists(thisOrderID) then
|
---|
241 | if ((TBADxRecord(tempDxList[i]).FOrderID = thisOrderID) and (tempDxList[i] <> nil)) then
|
---|
242 | begin
|
---|
243 | //tempDxList.Items[i] := nil; //remove reference to this item, effectively deleting it from the list (see Delphi help)
|
---|
244 | BACopiedOrderFlags.Clear;
|
---|
245 | UBAGlobals.SourceOrderID := '';
|
---|
246 | UBAGlobals.TargetOrderID := '';
|
---|
247 | tempDxList.Delete(i); //remove this item from the CIDC Dx list
|
---|
248 | end;
|
---|
249 | end;
|
---|
250 |
|
---|
251 | procedure ResetOrderID(fromID: string; toID: string);
|
---|
252 | var
|
---|
253 | i: integer;
|
---|
254 | begin
|
---|
255 | for i := 0 to tempDxList.Count-1 do
|
---|
256 | begin
|
---|
257 | if TBADxRecord(tempDxList[i]).FOrderID = fromID then
|
---|
258 | TBADxRecord(tempDxList[i]).FOrderID := toID;
|
---|
259 | end;
|
---|
260 | end;
|
---|
261 |
|
---|
262 | function GetTFCIForOrder(thisIndex: integer) : string;
|
---|
263 | {
|
---|
264 | Retrieve BA flags for 'thisOrderID', and convert them to CPRS type uSignItems.StsChar array.
|
---|
265 | }
|
---|
266 | begin
|
---|
267 | Result := BACopiedOrderFlags[thisIndex];
|
---|
268 | end;
|
---|
269 |
|
---|
270 | procedure CopyTFCIToTargetOrder(thisTargetOrderID: string; thisCheckBoxStatus: string);
|
---|
271 | var
|
---|
272 | i: integer;
|
---|
273 | begin
|
---|
274 | for i := 0 to tempDxList.Count - 1 do
|
---|
275 | if TBADxRecord(tempDxList[i]).FOrderID = thisTargetOrderID then
|
---|
276 | TBADxRecord(tempDxList[i]).FTreatmentFactors := thisCheckBoxStatus;
|
---|
277 | end;
|
---|
278 |
|
---|
279 | procedure BACopyOrder(sourceOrderList: TStringList);
|
---|
280 | { BAPHII 1.3.2
|
---|
281 | Copy source order to target order, including Dx's, Dx descriptions, Treatment Factors and Clinical Indicators
|
---|
282 | }
|
---|
283 | var
|
---|
284 | newList,rList: TStringList;
|
---|
285 | i: integer;
|
---|
286 | x: string;
|
---|
287 |
|
---|
288 | begin
|
---|
289 | newList := TStringList.Create;
|
---|
290 | rList := TSTRingList.Create;
|
---|
291 | newList.Clear;
|
---|
292 | rList.Clear;
|
---|
293 |
|
---|
294 | CopyDxRecord(UBAGlobals.SourceOrderID, UBAGlobals.TargetOrderID); //copy dx's to tempDxList record
|
---|
295 | newList.Add(UBAGlobals.SourceOrderID);
|
---|
296 | rList := rpcGetUnsignedOrdersBillingData(newList);
|
---|
297 |
|
---|
298 | if RList.Count > 0 then
|
---|
299 | begin
|
---|
300 | for i := 0 to rList.Count-1 do
|
---|
301 | begin
|
---|
302 | x := rList.Strings[i];
|
---|
303 | BACopiedOrderFlags.Add(TargetOrderID + '^' + Piece(x,U,2) );
|
---|
304 | end;
|
---|
305 | end
|
---|
306 | else
|
---|
307 | begin
|
---|
308 | BACopiedOrderFlags.Add(TargetOrderID + '^' + frmSignOrders.GetCheckBoxStatus(sourceOrderID) );
|
---|
309 | end;
|
---|
310 | end;
|
---|
311 |
|
---|
312 | procedure CopyTreatmentFactorsDxsToCopiedOrder(pSourceOrderID:string; pTargetOrderID:string);
|
---|
313 | {
|
---|
314 | BAPHII 1.3.2
|
---|
315 | }
|
---|
316 | var
|
---|
317 | sourceOrderList: TStringList;
|
---|
318 | sourceOrderID: TStringList;
|
---|
319 | targetOrderIDLst: TStringList;
|
---|
320 | begin
|
---|
321 | //Retrieve TF's/CI's from SOURCE Order
|
---|
322 | sourceOrderList := TStringList.Create;
|
---|
323 | targetOrderIDLst := TStringList.Create;
|
---|
324 | sourceOrderList.Clear;
|
---|
325 | targetOrderIDLst.Clear;
|
---|
326 | sourceOrderID := TStringList.Create;
|
---|
327 | sourceOrderID.Clear;
|
---|
328 | sourceOrderID.Add(Piece(pSourceOrderID, ';', 1));
|
---|
329 | targetOrderIDLst.Add(pTargetOrderID);
|
---|
330 | { if targetORderID is not billable do not create entry in BADXRecord - List fix HDS00003130}
|
---|
331 | rpcNonBillableOrders(targetOrderIDLst);
|
---|
332 | if IsOrderBillable(pTargetOrderID) then
|
---|
333 | begin
|
---|
334 | tCallV(sourceOrderList, 'ORWDBA4 GETTFCI', [sourceOrderID]);
|
---|
335 | BACopyOrder(sourceOrderList);
|
---|
336 | end;
|
---|
337 | end;
|
---|
338 |
|
---|
339 | procedure CopyTreatmentFactorsDxsToRenewedOrder;
|
---|
340 | {
|
---|
341 | BAPHII 1.3.2
|
---|
342 | }
|
---|
343 | var
|
---|
344 | sourceOrderList: TStringList;
|
---|
345 | sourceOrderID: TStringList;
|
---|
346 | targetOrderList: TStringList;
|
---|
347 | begin
|
---|
348 | //Retrieve TF's/CI's from SOURCE Order
|
---|
349 | sourceOrderList := TStringList.Create;
|
---|
350 | sourceOrderList.Clear;
|
---|
351 | sourceOrderID := TStringList.Create;
|
---|
352 | sourceOrderID.Clear;
|
---|
353 | targetOrderList := TStringList.Create;
|
---|
354 | targetOrderList.Clear;
|
---|
355 | sourceOrderID.Add(Piece(UBAGlobals.sourceOrderID, ';', 1));
|
---|
356 | { if targetORderID is not billable do not create entry in BADXRecord - List fix HDS00003130}
|
---|
357 | rpcNonBillableOrders(targetOrderList);
|
---|
358 | if IsOrderBillable(UBAGLobals.TargetOrderID) then
|
---|
359 | begin
|
---|
360 | tCallV(sourceOrderList, 'ORWDBA4 GETTFCI', [sourceOrderID]);
|
---|
361 | BACopyOrder(sourceOrderList); //BAPHII 1.3.2
|
---|
362 | end;
|
---|
363 | end;
|
---|
364 |
|
---|
365 | procedure PutBADxListForOrder(var thisRecord: TBADxRecord; thisOrderID: string);
|
---|
366 | { //existingRecord //targetOrderID }
|
---|
367 | var
|
---|
368 | i: integer;
|
---|
369 | thisRec: TBADxRecord;
|
---|
370 | begin
|
---|
371 | if UBAGlobals.tempDxNodeExists(thisOrderID) then
|
---|
372 | begin
|
---|
373 | if Assigned(tempDxList) then
|
---|
374 |
|
---|
375 | try
|
---|
376 | for i := 0 to (tempDxList.Count - 1) do
|
---|
377 | begin
|
---|
378 | thisRec := TBADxRecord(tempDxList.Items[i]);
|
---|
379 |
|
---|
380 | if Assigned(thisRec) then
|
---|
381 | if (thisRec.FOrderID = thisOrderID) then
|
---|
382 | begin
|
---|
383 | thisRec.FBADxCode := thisRecord.FBADxCode;
|
---|
384 | thisRec.FBASecDx1 := thisRecord.FBASecDx1;
|
---|
385 | thisRec.FBASecDx2 := thisRecord.FBASecDx2;
|
---|
386 | thisRec.FBASecDx3 := thisRecord.FBASecDx3;
|
---|
387 | thisRec.FTreatmentFactors := thisRecord.FTreatmentFactors;
|
---|
388 | end;
|
---|
389 | end;
|
---|
390 |
|
---|
391 | except
|
---|
392 | on EListError do
|
---|
393 | begin
|
---|
394 | {$ifdef debug}ShowMsg('EListError in UBAGlobals.PutBADxListForOrder()');{$endif}
|
---|
395 | raise;
|
---|
396 | end;
|
---|
397 | end;
|
---|
398 | end;
|
---|
399 | end;
|
---|
400 |
|
---|
401 | procedure CopyDxRecord(sourceOrderID: string; targetOrderID: string);
|
---|
402 | {
|
---|
403 | BAPHII 1.3.1
|
---|
404 | Copy contents of one TBADxRecord to another.
|
---|
405 | If target record does NOT exist, then add it to the Dx list.
|
---|
406 | If target record DOES exist, then change its contents to those of source record.
|
---|
407 | }
|
---|
408 | var
|
---|
409 | thisRecord: TBADxRecord;
|
---|
410 | thatRecord: TBADxRecord;
|
---|
411 | billingInfo: TstringList;
|
---|
412 | orderList: TStringList;
|
---|
413 | begin
|
---|
414 | thisRecord := TBADxRecord.Create;
|
---|
415 | thatRecord := TBADxRecord.Create;
|
---|
416 | billingInfo := TStringList.Create;
|
---|
417 | orderList := TStringList.Create;
|
---|
418 | if Assigned(billingInfo) then billingInfo.Clear;
|
---|
419 | if Assigned(orderList) then orderList.Clear;
|
---|
420 |
|
---|
421 | if tempDxNodeExists(sourceOrderID) then
|
---|
422 | GetBADxListForOrder(thisRecord, sourceOrderID); //load data from source
|
---|
423 |
|
---|
424 | if not tempDxNodeExists(targetOrderID) then
|
---|
425 | begin
|
---|
426 | SimpleAddTempDxList(targetOrderID);
|
---|
427 | orderList.Add(sourceOrderID);
|
---|
428 | billingInfo := rpcRetrieveSelectedOrderInfo(orderList);
|
---|
429 | if billingInfo.Count > 0 then
|
---|
430 | begin
|
---|
431 | thisRecord.FBADxCode := Piece(billingInfo.Strings[0],U,4) + U +
|
---|
432 | Piece(billingInfo.Strings[0],U,3);
|
---|
433 | thisRecord.FBASecDx1 := Piece(billingInfo.Strings[0],U,6) + U +
|
---|
434 | Piece(billingInfo.Strings[0],U,5);
|
---|
435 | thisRecord.FBASecDx2 := Piece(billingInfo.Strings[0],U,8) + U +
|
---|
436 | Piece(billingInfo.Strings[0],U,7);
|
---|
437 | thisRecord.FBASecDx3 := Piece(billingInfo.Strings[0],U,10) + U +
|
---|
438 | Piece(billingInfo.Strings[0],U,9);
|
---|
439 | if thisRecord.FBADxCode = CARET then thisRecord.FBADxCode := DXREC_INIT_FIELD_VAL;
|
---|
440 | if thisRecord.FBASecDx1 = CARET then thisRecord.FBASecDx1 := DXREC_INIT_FIELD_VAL ;
|
---|
441 | if thisRecord.FBASecDx2 = CARET then thisRecord.FBASecDx2 := DXREC_INIT_FIELD_VAL ;
|
---|
442 | if thisRecord.FBASecDx3 = CARET then thisRecord.FBASecDx3 := DXREC_INIT_FIELD_VAL ;
|
---|
443 |
|
---|
444 | end
|
---|
445 | else
|
---|
446 | PutBADxListForOrder(thisRecord, targetOrderID);
|
---|
447 | //copy source data to temporary record
|
---|
448 | with thatRecord do
|
---|
449 | begin
|
---|
450 | FOrderID := targetOrderID;
|
---|
451 | FBADxCode := thisRecord.FBADxCode;
|
---|
452 | FBASecDx1 := thisRecord.FBASecDx1;
|
---|
453 | FBASecDx2 := thisRecord.FBASecDx2;
|
---|
454 | FBASecDx3 := thisRecord.FBASecDx3;
|
---|
455 | PutBADxListForOrder(thatRecord, targetOrderID);
|
---|
456 | end;
|
---|
457 | end;
|
---|
458 | end;
|
---|
459 |
|
---|
460 |
|
---|
461 | function GetPrimaryDx(thisOrderID: string) : string;
|
---|
462 | {
|
---|
463 | BAPHII 1.3.1
|
---|
464 | }
|
---|
465 | var
|
---|
466 | retVal: TBADxRecord;
|
---|
467 | begin
|
---|
468 | retVal := TBADxRecord.Create;
|
---|
469 | GetBADxListForOrder(retVal, thisOrderID);
|
---|
470 | Result := retVal.FBADxCode;
|
---|
471 | end;
|
---|
472 |
|
---|
473 | function AllSelectedDxBlank(const Caller: smallint) : boolean;
|
---|
474 | var
|
---|
475 | i: smallint;
|
---|
476 | selectedOrderID: string;
|
---|
477 | begin
|
---|
478 | Result := true;
|
---|
479 |
|
---|
480 | case Caller of
|
---|
481 | F_ORDERS_SIGN: begin
|
---|
482 | try
|
---|
483 | for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Items.Count-1 do
|
---|
484 | if (frmSignOrders.clstOrders.Selected[i]) then
|
---|
485 | begin
|
---|
486 | selectedOrderID := TOrder(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
|
---|
487 | if (tempDxNodeExists(selectedOrderID)) then
|
---|
488 | Result := false;
|
---|
489 | end;
|
---|
490 | except
|
---|
491 | on EListError do
|
---|
492 | begin
|
---|
493 | {$ifdef debug}ShowMsg('EListError in UBAGlobals.AllSelectedDxBlank() - F_ORDERS_SIGN');{$endif}
|
---|
494 | raise;
|
---|
495 | end;
|
---|
496 | end;
|
---|
497 | end;
|
---|
498 | F_REVIEW: begin
|
---|
499 | try
|
---|
500 | for i := 0 to fReview.frmReview.lstReview.Items.Count-1 do
|
---|
501 | if (fReview.frmReview.lstReview.Selected[i]) then
|
---|
502 | begin
|
---|
503 | selectedOrderID := TOrder(fReview.frmReview.lstReview.Items.Objects[i]).ID;
|
---|
504 | if tempDxNodeExists(selectedOrderID) then
|
---|
505 | Result := false;
|
---|
506 | end;
|
---|
507 | except
|
---|
508 | on EListError do
|
---|
509 | begin
|
---|
510 | {$ifdef debug}ShowMsg('EListError in UBAGlobals.AllSelectedDxBlank() - F_REVIEW');{$endif}
|
---|
511 | raise;
|
---|
512 | end;
|
---|
513 | end;
|
---|
514 | end;
|
---|
515 | end; //case
|
---|
516 | end;
|
---|
517 |
|
---|
518 | function GetDxNodeIndex(thisOrderID: string) : smallint;
|
---|
519 | var
|
---|
520 | i: integer;
|
---|
521 | thisRec: TBADxRecord;
|
---|
522 | begin
|
---|
523 | Result := 0;
|
---|
524 |
|
---|
525 | if Assigned(tempDxList) then
|
---|
526 |
|
---|
527 | try
|
---|
528 | for i := 0 to (tempDxList.Count - 1) do
|
---|
529 | begin
|
---|
530 | thisRec := TBADxRecord(tempDxList.Items[i]);
|
---|
531 | if Assigned(thisRec) then
|
---|
532 | if (thisRec.FOrderID = thisOrderID) then
|
---|
533 | Result := i;
|
---|
534 | end;
|
---|
535 | except
|
---|
536 | on EListError do
|
---|
537 | begin
|
---|
538 | {$ifdef debug}ShowMsg('EListError in UBAGlobals.GetDxNodeIndex()');{$endif}
|
---|
539 | raise;
|
---|
540 | end;
|
---|
541 | end;
|
---|
542 | end;
|
---|
543 |
|
---|
544 | function DiagnosesMatch(var List1: TStringList; var List2: TStringList) : boolean;
|
---|
545 | var
|
---|
546 | i: smallint;
|
---|
547 | begin
|
---|
548 | Result := false;
|
---|
549 |
|
---|
550 | // If the number of Dx's in the lists differs, then bail
|
---|
551 | if (List1.Count <> List2.Count) then
|
---|
552 | begin
|
---|
553 | Result := false;
|
---|
554 | Exit;
|
---|
555 | end;
|
---|
556 |
|
---|
557 | List1.Sort;
|
---|
558 | List2.Sort;
|
---|
559 |
|
---|
560 | try
|
---|
561 | for i := 0 to (List1.Count - 1) do
|
---|
562 | if (List1.Strings[i] <> List2.Strings[i]) then
|
---|
563 | Result := false
|
---|
564 | else
|
---|
565 | Result := true;
|
---|
566 | except
|
---|
567 | on EListError do
|
---|
568 | begin
|
---|
569 | {$ifdef debug}ShowMsg('EListError in UBAGlobals.DiagnosesMatch()');{$endif}
|
---|
570 | raise;
|
---|
571 | end;
|
---|
572 | end;
|
---|
573 | end;
|
---|
574 |
|
---|
575 | function CountSelectedOrders(const Caller: smallint) : smallint;
|
---|
576 | var
|
---|
577 | i: integer;
|
---|
578 | selectedOrders: smallint;
|
---|
579 | begin
|
---|
580 | selectedOrders := 0;
|
---|
581 |
|
---|
582 | // How many orders selected?
|
---|
583 | case Caller of
|
---|
584 | F_ORDERS_SIGN: begin
|
---|
585 | try
|
---|
586 | for i := 0 to (fOrdersSign.frmSignOrders.clstOrders.Items.Count-1) do
|
---|
587 | if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
|
---|
588 | Inc(selectedOrders);
|
---|
589 | except
|
---|
590 | on EListError do
|
---|
591 | begin
|
---|
592 | {$ifdef debug}ShowMsg('EListError in UBAGlobals.CountSelectedOrders() - F_ORDERS_SIGN');{$endif}
|
---|
593 | raise;
|
---|
594 | end;
|
---|
595 | end;
|
---|
596 | end;
|
---|
597 | F_REVIEW: begin
|
---|
598 | try
|
---|
599 | for i := 0 to (fReview.frmReview.lstReview.Items.Count-1) do
|
---|
600 | if (fReview.frmReview.lstReview.Selected[i]) then
|
---|
601 | Inc(selectedOrders);
|
---|
602 | except
|
---|
603 | on EListError do
|
---|
604 | begin
|
---|
605 | {$ifdef debug}ShowMsg('EListError in UBAGlobals.CountSelectedOrders() - F_REVIEW');{$endif}
|
---|
606 | raise;
|
---|
607 | end;
|
---|
608 | end;
|
---|
609 | end;
|
---|
610 | end; //case
|
---|
611 |
|
---|
612 | Result := selectedOrders;
|
---|
613 |
|
---|
614 | end;
|
---|
615 |
|
---|
616 | function CompareOrderDx(const Caller: smallint) : boolean;
|
---|
617 | var
|
---|
618 | i: integer;
|
---|
619 | firstSelectedID: string;
|
---|
620 | thisOrderID: string;
|
---|
621 | firstDxRec: TBADxRecord;
|
---|
622 | compareDxRec: TBADxRecord;
|
---|
623 | thisStringList: TStringList;
|
---|
624 | thatStringList: TStringList;
|
---|
625 | begin
|
---|
626 | Result := false;
|
---|
627 | firstSelectedID := '';
|
---|
628 | firstDxRec := nil;
|
---|
629 | firstDxRec := TBADxRecord.Create;
|
---|
630 | thisStringList := TStringList.Create;
|
---|
631 | thisStringList.Clear;
|
---|
632 | thatStringList := TStringList.Create;
|
---|
633 | thatStringList.Clear;
|
---|
634 |
|
---|
635 | case Caller of
|
---|
636 | F_ORDERS_SIGN: begin
|
---|
637 | try
|
---|
638 | for i := 0 to (fOrdersSign.frmSignOrders.clstOrders.Items.Count-1) do
|
---|
639 | if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
|
---|
640 | begin
|
---|
641 | firstSelectedID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
|
---|
642 | Break;
|
---|
643 | end;
|
---|
644 | except
|
---|
645 | on EListError do
|
---|
646 | begin
|
---|
647 | {$ifdef debug}ShowMsg('EListError in UBAGlobals.CompareOrderDx() - F_ORDERS_SIGN');{$endif}
|
---|
648 | raise;
|
---|
649 | end;
|
---|
650 | end;
|
---|
651 | end;
|
---|
652 | F_REVIEW: begin
|
---|
653 | try
|
---|
654 | for i := 0 to (fReview.frmReview.lstReview.Items.Count-1) do
|
---|
655 | if (fReview.frmReview.lstReview.Selected[i]) then
|
---|
656 | begin
|
---|
657 | firstSelectedID := TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).ID;
|
---|
658 | Break;
|
---|
659 | end;
|
---|
660 | except
|
---|
661 | on EListError do
|
---|
662 | begin
|
---|
663 | {$ifdef debug}ShowMsg('EListError in UBAGlobals.CompareOrderDx() - F_REVIEW');{$endif}
|
---|
664 | raise;
|
---|
665 | end;
|
---|
666 | end;
|
---|
667 | end;
|
---|
668 | end; //case
|
---|
669 |
|
---|
670 | firstDxRec := TBADxRecord.Create;
|
---|
671 | InitializeNewDxRec(firstDxRec);
|
---|
672 | GetBADxListForOrder(firstDxRec, firstSelectedID);
|
---|
673 |
|
---|
674 | // first string to compare
|
---|
675 | thisStringList.Add(firstDxRec.FBADxCode);
|
---|
676 | thisStringList.Add(firstDxRec.FBASecDx1);
|
---|
677 | thisStringList.Add(firstDxRec.FBASecDx2);
|
---|
678 | thisStringList.Add(firstDxRec.FBASecDx3);
|
---|
679 |
|
---|
680 | case Caller of
|
---|
681 | F_ORDERS_SIGN: begin
|
---|
682 | try
|
---|
683 | for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Items.Count-1 do
|
---|
684 | if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
|
---|
685 | begin
|
---|
686 | thisOrderID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
|
---|
687 | // If order ID is same as the first selected order, then skip it
|
---|
688 | if thisOrderID = firstSelectedID then
|
---|
689 | Continue
|
---|
690 | else
|
---|
691 | begin
|
---|
692 | compareDxRec := TBADxRecord.Create;
|
---|
693 | InitializeNewDxRec(compareDxRec);
|
---|
694 | GetBADxListForOrder(compareDxRec, thisOrderID);
|
---|
695 |
|
---|
696 | thatStringList.Add(compareDxRec.FBADxCode);
|
---|
697 | thatStringList.Add(compareDxRec.FBASecDx1);
|
---|
698 | thatStringList.Add(compareDxRec.FBASecDx2);
|
---|
699 | thatStringList.Add(compareDxRec.FBASecDx3);
|
---|
700 |
|
---|
701 | if DiagnosesMatch(thisStringList, thatStringList) then
|
---|
702 | Result := true;
|
---|
703 | end;
|
---|
704 | end;
|
---|
705 | except
|
---|
706 | on EListError do
|
---|
707 | begin
|
---|
708 | {$ifdef debug}ShowMsg('EListError in UBAGlobals.CompareOrderDx() - F_ORDERS_SIGN');{$endif}
|
---|
709 | raise;
|
---|
710 | end;
|
---|
711 | end;
|
---|
712 | end;
|
---|
713 | F_REVIEW: begin
|
---|
714 | try
|
---|
715 | for i := 0 to fReview.frmReview.lstReview.Items.Count-1 do
|
---|
716 | if (fReview.frmReview.lstReview.Selected[i]) then
|
---|
717 | begin
|
---|
718 | thisOrderID := TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).ID;
|
---|
719 | // If order ID is same as the first selected order, then skip it
|
---|
720 | if thisOrderID = firstSelectedID then
|
---|
721 | Continue
|
---|
722 | else
|
---|
723 | begin
|
---|
724 | compareDxRec := TBADxRecord.Create;
|
---|
725 | InitializeNewDxRec(compareDxRec);
|
---|
726 | GetBADxListForOrder(compareDxRec, thisOrderID);
|
---|
727 |
|
---|
728 | thatStringList.Add(compareDxRec.FBADxCode);
|
---|
729 | thatStringList.Add(compareDxRec.FBASecDx1);
|
---|
730 | thatStringList.Add(compareDxRec.FBASecDx2);
|
---|
731 | thatStringList.Add(compareDxRec.FBASecDx3);
|
---|
732 |
|
---|
733 | if DiagnosesMatch(thisStringList, thatStringList) then
|
---|
734 | Result := true;
|
---|
735 | end;
|
---|
736 | end;
|
---|
737 | except
|
---|
738 | on EListError do
|
---|
739 | begin
|
---|
740 | {$ifdef debug}ShowMsg('EListError in UBAGlobals.CompareOrderDx() - F_REVIEW');{$endif}
|
---|
741 | raise;
|
---|
742 | end;
|
---|
743 | end;
|
---|
744 | end;
|
---|
745 | end; //case
|
---|
746 |
|
---|
747 | if Assigned(thisStringList) then
|
---|
748 | FreeAndNil(thisStringList);
|
---|
749 |
|
---|
750 | if Assigned(thatStringList) then
|
---|
751 | FreeAndNil(thatStringList);
|
---|
752 | end;
|
---|
753 |
|
---|
754 | procedure GetBADxListForOrder(var thisRetVal: TBADxRecord; thisOrderID: string);
|
---|
755 | var
|
---|
756 | i: integer;
|
---|
757 | thisRec: TBADxRecord;
|
---|
758 | begin
|
---|
759 | if UBAGlobals.tempDxNodeExists(thisOrderID) then
|
---|
760 | begin
|
---|
761 |
|
---|
762 | if Assigned(tempDxList) then
|
---|
763 | for i := 0 to (tempDxList.Count - 1) do
|
---|
764 | begin
|
---|
765 | thisRec := TBADxRecord(tempDxList.Items[i]);
|
---|
766 |
|
---|
767 | if Assigned(thisRec) then
|
---|
768 | if (thisRec.FOrderID = thisOrderID) then
|
---|
769 | begin
|
---|
770 | with thisRetVal do
|
---|
771 | begin
|
---|
772 | FOrderID := thisRec.FOrderID;
|
---|
773 | FBADxCode := StringReplace(thisrec.FBADxCode,'^',':',[rfReplaceAll]);
|
---|
774 | FBASecDx1 := StringReplace(thisrec.FBASecDx1,'^',':',[rfReplaceAll]);
|
---|
775 | FBASecDx2 := StringReplace(thisrec.FBASecDx2,'^',':',[rfReplaceAll]);;
|
---|
776 | FBASecDx3 := StringReplace(thisrec.FBASecDx3,'^',':',[rfReplaceAll]);
|
---|
777 | end;
|
---|
778 | end;
|
---|
779 | end;
|
---|
780 | end;
|
---|
781 | end;
|
---|
782 |
|
---|
783 | procedure DestroyDxList;
|
---|
784 | var
|
---|
785 | i: integer;
|
---|
786 | begin
|
---|
787 | if Assigned(tempDxList) then
|
---|
788 | for i := 0 to pred(UBAGlobals.tempDxList.Count) do
|
---|
789 | TObject(tempDxList[i]).Free;
|
---|
790 |
|
---|
791 | tempDxList := nil;
|
---|
792 | FreeAndNil(tempDxList);
|
---|
793 | end;
|
---|
794 |
|
---|
795 | procedure SimpleAddTempDxList(thisOrderID: string);
|
---|
796 | var
|
---|
797 | tempDxRec: TBADxRecord;
|
---|
798 | begin
|
---|
799 | frmBALocalDiagnoses.LoadTempRec(tempDxRec, thisOrderID);
|
---|
800 | UBAGlobals.tempDxList.Add(TBADxRecord(tempDxRec));
|
---|
801 | end;
|
---|
802 |
|
---|
803 | procedure SetBADxList;
|
---|
804 | var
|
---|
805 | i: smallint;
|
---|
806 | begin
|
---|
807 | if not Assigned(UBAGlobals.tempDxList) then
|
---|
808 | begin
|
---|
809 | UBAGlobals.tempDxList := TList.Create;
|
---|
810 | UBAGlobals.tempDxList.Count := 0;
|
---|
811 | end
|
---|
812 | else
|
---|
813 | begin
|
---|
814 | //Kill the old Dx list
|
---|
815 | for i := 0 to pred(UBAGlobals.tempDxList.Count) do
|
---|
816 | TObject(UBAGlobals.tempDxList[i]).Free;
|
---|
817 |
|
---|
818 | UBAGlobals.tempDxList := nil;
|
---|
819 |
|
---|
820 | //Create new Dx list for newly selected patient
|
---|
821 | if not Assigned(UBAGlobals.tempDxList) then
|
---|
822 | begin
|
---|
823 | UBAGlobals.tempDxList := TList.Create;
|
---|
824 | UBAGlobals.tempDxList.Count := 0;
|
---|
825 | end;
|
---|
826 | end;
|
---|
827 | end;
|
---|
828 |
|
---|
829 | procedure SetBADxListForOrder(thisRec: TBADxRecord; thisOrderID: string);
|
---|
830 | var
|
---|
831 | i: integer;
|
---|
832 | foundRec: TBADxRecord;
|
---|
833 | begin
|
---|
834 | if UBAGlobals.tempDxNodeExists(thisOrderID) then
|
---|
835 | begin
|
---|
836 | foundRec := TBADxRecord.Create;
|
---|
837 |
|
---|
838 | if Assigned(tempDxList) then
|
---|
839 | try
|
---|
840 | for i := 0 to (tempDxList.Count - 1) do
|
---|
841 | begin
|
---|
842 | foundRec := TBADxRecord(tempDxList.Items[i]);
|
---|
843 |
|
---|
844 | if Assigned(thisRec) then
|
---|
845 | if (thisOrderID = foundRec.FOrderID) then
|
---|
846 | begin
|
---|
847 | with foundRec do
|
---|
848 | begin
|
---|
849 | FOrderID := thisRec.FOrderID;
|
---|
850 | FBADxCode := thisRec.FBADxCode;
|
---|
851 | FBASecDx1 := thisRec.FBASecDx1;
|
---|
852 | FBASecDx2 := thisRec.FBASecDx2;
|
---|
853 | FBASecDx3 := thisRec.FBASecDx3;
|
---|
854 | PutBADxListForOrder(foundRec, thisOrderID);
|
---|
855 | end;
|
---|
856 | Break;
|
---|
857 | end;
|
---|
858 | end;
|
---|
859 | except
|
---|
860 | on EListError do
|
---|
861 | begin
|
---|
862 | {$ifdef debug}ShowMsg('EListError in UBAGlobals.SetBADxListForOrder()');{$endif}
|
---|
863 | raise;
|
---|
864 | end;
|
---|
865 | end;
|
---|
866 | end;
|
---|
867 | end;
|
---|
868 |
|
---|
869 | function SecondaryDxFull(thisOrderID: string) : boolean;
|
---|
870 | var
|
---|
871 | i: integer;
|
---|
872 | thisRec: TBADxRecord;
|
---|
873 | begin
|
---|
874 | Result := false;
|
---|
875 |
|
---|
876 | try
|
---|
877 | for i := 0 to tempDxList.Count - 1 do
|
---|
878 | begin
|
---|
879 | thisRec := TBADxRecord(tempDxList.Items[i]);
|
---|
880 |
|
---|
881 | if Assigned(thisRec) then
|
---|
882 | if thisRec.FOrderID = thisOrderID then
|
---|
883 | begin
|
---|
884 | if (thisRec.FBADxCode <> UBAConst.DXREC_INIT_FIELD_VAL) then
|
---|
885 | if (thisRec.FBASecDx1 <> UBAConst.DXREC_INIT_FIELD_VAL) then
|
---|
886 | if (thisRec.FBASecDx2 <> UBAConst.DXREC_INIT_FIELD_VAL) then
|
---|
887 | if (thisRec.FBASecDx3 <> UBAConst.DXREC_INIT_FIELD_VAL) then
|
---|
888 | Result := true;
|
---|
889 | end;
|
---|
890 | end;
|
---|
891 | except
|
---|
892 | on EListError do
|
---|
893 | begin
|
---|
894 | {$ifdef debug}ShowMsg('EListError in UBAGlobals.SecondaryDxFull()');{$endif}
|
---|
895 | raise;
|
---|
896 | end;
|
---|
897 | end;
|
---|
898 | end;
|
---|
899 |
|
---|
900 | procedure AddSecondaryDx(thisOrderID: string; thisDxCode: string);
|
---|
901 | // Add a Secondary Dx to the first open slot in DxRec, if there IS an open slot
|
---|
902 | var
|
---|
903 | thisRec: TBADxRecord;
|
---|
904 | i: integer;
|
---|
905 | begin
|
---|
906 |
|
---|
907 | try
|
---|
908 | for i := 0 to tempDxList.Count - 1 do
|
---|
909 | begin
|
---|
910 | thisRec := TBADxRecord(tempDxList.Items[i]);
|
---|
911 |
|
---|
912 | if thisRec.FOrderID = thisOrderID then
|
---|
913 | begin
|
---|
914 | if (thisRec.FBASecDx1 = UBAConst.DXREC_INIT_FIELD_VAL) then
|
---|
915 | thisRec.FBASecDx1 := thisDxCode
|
---|
916 | else
|
---|
917 | if (thisRec.FBASecDx2 = UBAConst.DXREC_INIT_FIELD_VAL) then
|
---|
918 | thisRec.FBASecDx2 := thisDxCode
|
---|
919 | else
|
---|
920 | if (thisRec.FBASecDx3 = UBAConst.DXREC_INIT_FIELD_VAL) then
|
---|
921 | thisRec.FBASecDx3 := thisDxCode;
|
---|
922 | end
|
---|
923 | end;
|
---|
924 | except
|
---|
925 | on EListError do
|
---|
926 | begin
|
---|
927 | {$ifdef debug}ShowMsg('EListError in UBAGlobals.AddSecondaryDx()');{$endif}
|
---|
928 | raise;
|
---|
929 | end;
|
---|
930 | end;
|
---|
931 | end;
|
---|
932 |
|
---|
933 | procedure InitializeConsultOrderRec(var thisDxRec: TBAConsultOrderRec);
|
---|
934 | begin
|
---|
935 | with thisDxRec do
|
---|
936 | begin
|
---|
937 | FBAOrderID := UBAConst.DXREC_INIT_FIELD_VAL;
|
---|
938 | FBADxCode := UBAConst.DXREC_INIT_FIELD_VAL;
|
---|
939 | FBASecDx1 := UBAConst.DXREC_INIT_FIELD_VAL;
|
---|
940 | FBASecDx2 := UBAConst.DXREC_INIT_FIELD_VAL;
|
---|
941 | FBASecDx3 := UBAConst.DXREC_INIT_FIELD_VAL;
|
---|
942 | FBATreatmentFactors:= UBAConst.DXREC_INIT_FIELD_VAL;
|
---|
943 | end;
|
---|
944 | end;
|
---|
945 |
|
---|
946 |
|
---|
947 | procedure InitializeNewDxRec(var thisDxRec: TBADxRecord);
|
---|
948 | begin
|
---|
949 | with thisDxRec do
|
---|
950 | begin
|
---|
951 | FExistingRecordID := UBAConst.DXREC_INIT_FIELD_VAL;
|
---|
952 | FOrderID := UBAConst.DXREC_INIT_FIELD_VAL;
|
---|
953 | FBADxCode := UBAConst.DXREC_INIT_FIELD_VAL;
|
---|
954 | FBASecDx1 := UBAConst.DXREC_INIT_FIELD_VAL;
|
---|
955 | FBASecDx2 := UBAConst.DXREC_INIT_FIELD_VAL;
|
---|
956 | FBASecDx3 := UBAConst.DXREC_INIT_FIELD_VAL;
|
---|
957 | end;
|
---|
958 | end;
|
---|
959 |
|
---|
960 | procedure InitializeUnsignedOrderRec(var thisUnsignedRec: TBAUnsignedBillingRec);
|
---|
961 | begin
|
---|
962 | with thisUnsignedRec do
|
---|
963 | begin
|
---|
964 | FBAOrderID := UNSIGNED_REC_INIT_FIELD_VAL;
|
---|
965 | FBASTSFlags := UNSIGNED_REC_INIT_FIELD_VAL;
|
---|
966 | FBADxCode := UNSIGNED_REC_INIT_FIELD_VAL;
|
---|
967 | FBASecDx1 := UNSIGNED_REC_INIT_FIELD_VAL;
|
---|
968 | FBASecDx2 := UNSIGNED_REC_INIT_FIELD_VAL;
|
---|
969 | FBASecDx3 := UNSIGNED_REC_INIT_FIELD_VAL;
|
---|
970 | end;
|
---|
971 | end;
|
---|
972 |
|
---|
973 | procedure InitializeTFactorsInRec(var thisTFactorsRecIn: TBATreatmentFactorsInRec);
|
---|
974 | begin
|
---|
975 | with thisTFactorsRecIn do
|
---|
976 | begin
|
---|
977 | FBAOrderID := UNSIGNED_REC_INIT_FIELD_VAL;
|
---|
978 | FBAEligible := UNSIGNED_REC_INIT_FIELD_VAL;
|
---|
979 | FBATFactors := UNSIGNED_REC_INIT_FIELD_VAL;
|
---|
980 | end;
|
---|
981 | end;
|
---|
982 | constructor TBAGlobals.Create;
|
---|
983 | begin
|
---|
984 | inherited Create;
|
---|
985 | end;
|
---|
986 | // This procedure is called from uPCE.pas only -- do not delete.....
|
---|
987 | procedure TBAGlobals.AddBAPCEDiag(DiagStr:string);
|
---|
988 | begin
|
---|
989 | if (BAPCEDiagList.Count <= 0) then
|
---|
990 | BAPCEDiagList.Add('^Encounter Diagnoses');
|
---|
991 |
|
---|
992 | BAPCEDiagList.Add(DiagStr);
|
---|
993 | end;
|
---|
994 |
|
---|
995 | procedure TBAGlobals.ClearBAPCEDiagList;
|
---|
996 | begin
|
---|
997 |
|
---|
998 | BAPCEDiagList.Clear;
|
---|
999 | end;
|
---|
1000 |
|
---|
1001 | constructor TBAPLRec.Create;
|
---|
1002 | begin
|
---|
1003 | inherited Create;
|
---|
1004 | end;
|
---|
1005 |
|
---|
1006 | function TBAPLRec.BuildProblemListDxEntry(pDxCode:string): TStringList;
|
---|
1007 | // StringList used to store DX Codes selected from Encounter Form
|
---|
1008 | var
|
---|
1009 | BADxIEN: string;
|
---|
1010 | BAProviderStr, BAProviderName : string;
|
---|
1011 | AList: TStringList;
|
---|
1012 | begin
|
---|
1013 | // Build Problem List record to be saved for selection.
|
---|
1014 | PLlist := TStringList.Create;
|
---|
1015 | AList := TStringList.Create;
|
---|
1016 | AList.Clear;
|
---|
1017 | PLlist.Clear;
|
---|
1018 | BALocation := Encounter.Location;
|
---|
1019 | BAProviderStr := IntToStr(Encounter.Provider);
|
---|
1020 | BAProviderName := Encounter.ProviderName;
|
---|
1021 | BADxIEN := sCallV('ORWDBA7 GETIEN9', [Piece(pDxCode,U,1)]);
|
---|
1022 | BAPLPt.LoadPatientParams(AList);
|
---|
1023 |
|
---|
1024 | //BAPLPt.PtVAMC
|
---|
1025 | PLlist.Add('GMPFLD(.01)='+'"' +BADxIEN+ '^'+Piece(pDxCode,U,1)+'"');
|
---|
1026 | PLlist.Add('GMPFLD(.03)=' +'"'+'0^' +'"');
|
---|
1027 | PLlist.Add('GMPFLD(.05)=' + '"' +'^'+Piece(pDxCode,U,2)+ '"');
|
---|
1028 | PLlist.Add('GMPFLD(.08)=' + '"'+ '^'+FloatToStr(FMToday)+'"');
|
---|
1029 | PLlist.Add('GMPFLD(.12)=' + '"' + 'A^ACTIVE'+ '"');
|
---|
1030 | PLlist.Add('GMPFLD(.13)=' + '"' + '^'+ '"');
|
---|
1031 | PLlist.Add('GMPFLD(1.01)=' + '"'+ Piece(pDxCode,U,2) + '"');
|
---|
1032 | PLlist.Add('GMPFLD(1.02)=' + '"'+'P' + '"');
|
---|
1033 | PLlist.Add('GMPFLD(1.03)=' + '"'+ BAProviderStr + '^'+ BAProviderName + '"');
|
---|
1034 | PLlist.Add('GMPFLD(1.04)=' + '"'+ BAProviderStr + '^' + BAProviderName + '"');
|
---|
1035 | PLlist.Add('GMPFLD(1.05)=' + '"'+ BAProviderStr + '^' + BAProviderName + '"');
|
---|
1036 | PLlist.Add('GMPFLD(1.08)=' +'"' + IntToStr(BALocation) + '^' + Encounter.LocationName + '"');
|
---|
1037 | PLlist.Add('GMPFLD(1.09)=' + '"'+ FloatToStr(FMToday) +'"');
|
---|
1038 | PLlist.Add('GMPFLD(10,0)=' + '"'+'0'+ '"');
|
---|
1039 | Result := PLlist;
|
---|
1040 |
|
---|
1041 | end;
|
---|
1042 |
|
---|
1043 | function TBAPLRec.FMToDateTime(FMDateTime: string): TDateTime;
|
---|
1044 | var
|
---|
1045 | x, Year: string;
|
---|
1046 | begin
|
---|
1047 | { Note: TDateTime cannot store month only or year only dates }
|
---|
1048 | x := FMDateTime + '0000000';
|
---|
1049 | if Length(x) > 12 then x := Copy(x, 1, 12);
|
---|
1050 | if StrToInt(Copy(x, 9, 4)) > 2359 then x := Copy(x,1,7) + '.2359';
|
---|
1051 | Year := IntToStr(17 + StrToInt(Copy(x,1,1))) + Copy(x,2,2);
|
---|
1052 | x := Copy(x,4,2) + '/' + Copy(x,6,2) + '/' + Year + ' ' + Copy(x,9,2) + ':' + Copy(x,11,2);
|
---|
1053 | Result := StrToDateTime(x);
|
---|
1054 | end;
|
---|
1055 |
|
---|
1056 | {-------------------------- TPLPt Class ----------------------}
|
---|
1057 | constructor TBAPLPT.Create(Alist:TStringList);
|
---|
1058 | var
|
---|
1059 | i: integer;
|
---|
1060 | begin
|
---|
1061 | for i := 0 to AList.Count - 1 do
|
---|
1062 | case i of
|
---|
1063 | 0: PtVAMC := Copy(Alist[i],1,999);
|
---|
1064 | 1: PtDead := AList[i];
|
---|
1065 | 2: PtServiceConnected := (AList[i] = '1');
|
---|
1066 | 3: PtAgentOrange := (AList[i] = '1');
|
---|
1067 | 4: PtRadiation := (AList[i] = '1');
|
---|
1068 | 5: PtEnvironmental := (AList[i] = '1');
|
---|
1069 | 6: PtBID := Alist[i];
|
---|
1070 | 7: PtHNC := (AList[i] = '1');
|
---|
1071 | 8: PtMST := (AList[i] = '1');
|
---|
1072 | 9: PtSHAD := (AList[i] = '1');
|
---|
1073 | end;
|
---|
1074 | end;
|
---|
1075 |
|
---|
1076 | function TBAPLPt.GetGMPDFN(dfn:string;name:string):string;
|
---|
1077 | begin
|
---|
1078 | Result := dfn + u + name + u + PtBID + u + PtDead;
|
---|
1079 | end;
|
---|
1080 |
|
---|
1081 | procedure TBAPLPt.LoadPatientParams(AList:TstringList);
|
---|
1082 | begin
|
---|
1083 | FastAssign(rpcInitPt(Patient.DFN), AList);
|
---|
1084 | BAPLPt := TBAPLPt.create(Alist);
|
---|
1085 | end;
|
---|
1086 |
|
---|
1087 | function TBAPLPt.rpcInitPt(const PatientDFN: string): TStrings ; //*DFN*
|
---|
1088 | begin
|
---|
1089 | CallV('ORQQPL INIT PT',[PatientDFN]);
|
---|
1090 | Result := RPCBrokerV.Results;
|
---|
1091 | end ;
|
---|
1092 |
|
---|
1093 | function tempDxNodeExists(thisOrderID: string) : boolean;
|
---|
1094 | // Returns true if a node with the specified Order ID exists, false otherwise.
|
---|
1095 | var
|
---|
1096 | i: integer;
|
---|
1097 | thisRec: TBADxRecord;
|
---|
1098 | begin
|
---|
1099 | Result := false;
|
---|
1100 | if Assigned(tempDxList) then
|
---|
1101 | try
|
---|
1102 | for i := 0 to (tempDxList.Count - 1) do
|
---|
1103 | begin
|
---|
1104 | thisRec := TBADxRecord(tempDxList.Items[i]);
|
---|
1105 |
|
---|
1106 | if Assigned(thisRec) then
|
---|
1107 | if (thisRec.FOrderID = thisOrderID) then
|
---|
1108 | begin
|
---|
1109 | Result := true;
|
---|
1110 | Break;
|
---|
1111 | end;
|
---|
1112 | end;
|
---|
1113 | except
|
---|
1114 | on EListError do
|
---|
1115 | begin
|
---|
1116 | {$ifdef debug}ShowMsg('EListError in UBAGlobals.tempDxNodeExists()');{$endif}
|
---|
1117 | raise;
|
---|
1118 | end;
|
---|
1119 | end;
|
---|
1120 | end;
|
---|
1121 | // HDS00003380
|
---|
1122 | function IsUserNurseProvider(pUserID: int64):boolean;
|
---|
1123 | begin
|
---|
1124 | Result := False;
|
---|
1125 | if BILLING_AWARE then
|
---|
1126 | begin
|
---|
1127 | if (pUserID <> 0) and PersonHasKey(pUserID, 'PROVIDER') then
|
---|
1128 | if (uCore.User.OrderRole = OR_NURSE) then
|
---|
1129 | Result := True;
|
---|
1130 | end;
|
---|
1131 | end;
|
---|
1132 |
|
---|
1133 | function GetPatientTFactors(pOrderList:TStringList):String;
|
---|
1134 | begin
|
---|
1135 | Result := '';
|
---|
1136 | Result := sCallV('ORWDBA1 SCLST',[Patient.DFN,pOrderList]);
|
---|
1137 | end;
|
---|
1138 |
|
---|
1139 |
|
---|
1140 | Initialization
|
---|
1141 | BAPrimaryDxChanged := False;
|
---|
1142 | BAFWarningShown := False;
|
---|
1143 | BAPersonalDX := False;
|
---|
1144 | BAHoldPrimaryDx := DXREC_INIT_FIELD_VAL;
|
---|
1145 | NonBillableOrderList := TStringList.Create;
|
---|
1146 | BAPCEDiagList := TStringList.Create;
|
---|
1147 | OrderListSCEI := TStringList.Create;
|
---|
1148 | BAOrderList := TStringList.Create;
|
---|
1149 | UnSignedOrders := TStringList.Create;
|
---|
1150 | BAOrderIDList := TStringList.Create;
|
---|
1151 | BAUnSignedOrders := TStringList.Create;
|
---|
1152 | BATFHints := TStringList.Create;
|
---|
1153 | BAFactorsRec := TBAFactorsRec.Create;
|
---|
1154 | BAFactorsInRec := TBATreatmentFactorsInRec.Create;
|
---|
1155 | BASelectedList := TStringList.Create;
|
---|
1156 | PLFactorsIndexes := TStringList.Create;
|
---|
1157 | BAtmpOrderList := TStringList.Create;
|
---|
1158 | BACopiedOrderFlags := TStringList.Create; //BAPHII 1.3.2
|
---|
1159 | OrderIDList := TStringList.Create;
|
---|
1160 | BAConsultDxList := TStringList.Create;
|
---|
1161 | BAConsultPLFlags := TStringList.Create;
|
---|
1162 | BANurseConsultOrders := TStringList.Create;
|
---|
1163 | BADeltedOrders := TStringList.Create;
|
---|
1164 | BAConsultDxList.Clear;
|
---|
1165 | NonBillableOrderList.Clear;
|
---|
1166 | OrderListSCEI.Clear;
|
---|
1167 | UnSignedOrders.Clear;
|
---|
1168 | BAOrderIDList.Clear;
|
---|
1169 | BAUnSignedOrders.Clear;
|
---|
1170 | BATFHints.Clear;
|
---|
1171 | PLFactorsIndexes.Clear;
|
---|
1172 | BASelectedList.Clear;
|
---|
1173 | BAtmpOrderList.Clear;
|
---|
1174 | OrderIDList.Clear;
|
---|
1175 | BAConsultPLFlags.Clear;
|
---|
1176 | BAPCEDiagList.Clear;
|
---|
1177 | BANurseConsultOrders.Clear;
|
---|
1178 | BADeltedOrders.Clear;
|
---|
1179 |
|
---|
1180 | end.
|
---|
1181 |
|
---|
1182 |
|
---|
1183 |
|
---|