1 | unit UBACore;
|
---|
2 |
|
---|
3 | {.$define debug}
|
---|
4 |
|
---|
5 | interface
|
---|
6 | uses
|
---|
7 | Classes, ORNet, uConst, ORFn, Sysutils, Dialogs, Windows,Messages, UBAGlobals,Trpcb,
|
---|
8 | fFrame;
|
---|
9 |
|
---|
10 | function rpcAddToPersonalDxList(UserDUZ:int64; DxCodes:TStringList):boolean;
|
---|
11 | function rpcGetPersonalDxList(UserDUZ:int64):TStringList;
|
---|
12 | function rpcDeleteFromPersonalDxList(UserDUZ:int64; Dest:TStringList):integer;
|
---|
13 | procedure rpcSaveBillingData(pBillingData:TStringList);
|
---|
14 | function rpcNonBillableOrders(pOrderList: TStringList): TStringList;
|
---|
15 | function rpcOrderRequiresDx(pList: TStringList):boolean;
|
---|
16 | procedure rpcSetBillingAwareSwitch(encProvider: int64; encLocation: integer);
|
---|
17 | procedure rpcGetProviderPatientDaysDx(ProviderIEN: string;PatientIEN: string);
|
---|
18 | procedure rpcGetSC4Orders; // returns Eligible Treatment Factors for a given patient
|
---|
19 | procedure rpcSaveBillingDxEntered; // save dx enteries regardless of being mandatory....
|
---|
20 | function rpcTreatmentFactorsActive(pOrderID: string):boolean;
|
---|
21 | procedure rpcBuildSCIEList(pOrderList: TList);
|
---|
22 | function rpcGetUnsignedOrdersBillingData(pOrderList: TStringList):TStringList;
|
---|
23 | function rpcRetrieveBillingData(thisOrderID: string; var thisBAData: string) : boolean;
|
---|
24 | function rpcRetrieveSelectedOrderInfo(pOrderIDList: TStringList):TStringList;
|
---|
25 | function rpcGetTFHintData:TStringList;
|
---|
26 | procedure rpcSaveNurseConsultOrder(pOrderRec:TStringList);
|
---|
27 | function rpcGetBAMasterSwStatus:boolean;
|
---|
28 |
|
---|
29 | function OrdersHaveDx(pOrderList:TStringList):boolean;
|
---|
30 | procedure SetTreatmentFactors(TFactors: string);
|
---|
31 | function AttachDxToOrderList(pOrderList:TStringList):TStringList;
|
---|
32 | procedure AttachPLTFactorsToDx(var Dest:String;ProblemRec:string);
|
---|
33 | procedure BALoadStsFlagsAsIs(StsFlagsIN: string);
|
---|
34 | function BADxEntered:boolean; // This will only be executed if bypass switch is set...
|
---|
35 | function StripTFactors(FactorsIN: string): string;
|
---|
36 | function AddProviderPatientDaysDx(Dest: TStringList; ProviderIEN: string;PatientIEN: string) : TStringList;
|
---|
37 | function IsOrderBillable(pOrderID: string):boolean;
|
---|
38 |
|
---|
39 | function OrderRequiresSCEI(pOrderID :String): boolean;
|
---|
40 | procedure SaveUnsignedOrders(pOrderRec:String);
|
---|
41 |
|
---|
42 | procedure CompleteUnsignedBillingInfo(pOrderList: TStringList);
|
---|
43 | procedure BuildSaveUnsignedList(pOrderList: TStringList);
|
---|
44 | procedure LoadUnsignedOrderRec(var thisRetVal: TBAUnsignedBillingRec;UnsignedBillingInfo:string);
|
---|
45 | function GetUnsignedOrderFlags(pOrderID: string; pFlagList: TStringList):string; // returns STSFlags if found
|
---|
46 | procedure BuildTFHintRec;
|
---|
47 | function IsAllOrdersNA(pOrderList:TStringList):boolean;
|
---|
48 | function PrepOrderID(pOrderID:String): String;
|
---|
49 | procedure ClearSelectedOrderDiagnoses(pOrderIDList: TStringList);
|
---|
50 | procedure LoadConsultOrderRec(var thisRetVal: TBAConsultOrderRec; pOrderID: String; pDxList: TStringList);
|
---|
51 | procedure CompleteConsultOrderRec(pOrderID: string; pDxList: TStringList);
|
---|
52 | function GetConsultFlags(pOrderID:String; pFlagList:TStringList;FlagsAsIs:string):string;
|
---|
53 | function SetConsultFlags(pPLFactors: string;pFlagsAsIs: string):string; // return updated flags.
|
---|
54 | procedure GetBAStatus(pProvider:int64; pLocation:integer);
|
---|
55 | function IsICD9CodeActive(ACode: string; LexApp: string; ADate:TFMDateTime = 0): boolean;
|
---|
56 | function BuildConsultDxRec(ConsultRec: TBAConsultOrderRec): string;
|
---|
57 | function ConvertPIMTreatmentFactors(pTFactors:string):string;
|
---|
58 | procedure DeleteDCOrdersFromCopiedList(pOrderID:string);
|
---|
59 | //function SetOrderIDConsultDxRequired(pOrderID:String):String; // replace orderid with "R" if consult dx required.
|
---|
60 | procedure UpdateBAConsultOrderList(pDcOrders: TStringList);
|
---|
61 |
|
---|
62 |
|
---|
63 |
|
---|
64 |
|
---|
65 | var
|
---|
66 | uAddToPDl: integer;
|
---|
67 | uDeleteFromPDL: integer;
|
---|
68 | uDxLst: TStringList;
|
---|
69 | BADxList: TStringList;
|
---|
70 |
|
---|
71 | implementation
|
---|
72 |
|
---|
73 | uses fBALocalDiagnoses, fOrdersSign, fReview, rOrders, uCore, rCore, rPCE,uPCE,
|
---|
74 | UBAConst, UBAMessages, USignItems;
|
---|
75 |
|
---|
76 |
|
---|
77 | function rpcRetrieveBillingData(thisOrderID: string; var thisBAData: string) : boolean;
|
---|
78 | var
|
---|
79 | rpcResult: TStringList;
|
---|
80 | BAOrderExists : boolean;
|
---|
81 | begin
|
---|
82 | Result := false;
|
---|
83 | BAOrderExists := false;
|
---|
84 | rpcResult := TStringList.Create;
|
---|
85 |
|
---|
86 | tCallV(rpcResult, 'ORWDBA1 RCVORCI', [thisOrderID]);
|
---|
87 | BAOrderExists := StrToBool(rpcResult[0]);
|
---|
88 |
|
---|
89 | if (not BAOrderExists) then
|
---|
90 | //GRAB RETURNED BA DATA HERE
|
---|
91 | Result := true;
|
---|
92 | end;
|
---|
93 |
|
---|
94 | procedure rpcSaveBillingData(pBillingData:TStringList);
|
---|
95 | var
|
---|
96 | RecsToSave: TStringList;
|
---|
97 | i: integer;
|
---|
98 | x: string;
|
---|
99 | begin
|
---|
100 | RecsToSave := TStringList.Create;
|
---|
101 | RecsToSave.Clear;
|
---|
102 | RecsToSave := AttachDxToOrderList(pBillingData); //call with new Biling data, return-code returned
|
---|
103 | // for i := 0 to RecstoSave.Count-1 do
|
---|
104 | // begin
|
---|
105 | // ShowMessage('Data Sent to ORW ' + RecsToSave.Strings[i]);
|
---|
106 | // end;
|
---|
107 | CallV('ORWDBA1 RCVORCI',[RecsToSave]);
|
---|
108 | // if Assigned(UBAGlobals.BAConsultOrdersRequireDx) then UBAGlobals.BAConsultOrdersRequireDx.Clear;
|
---|
109 | if Assigned(UBAGlobals.BAOrderList) then UBAGlobals.BAOrderList.Clear; // hds00005025
|
---|
110 | end;
|
---|
111 |
|
---|
112 | function rpcTreatmentFactorsActive(pOrderID:string): boolean;
|
---|
113 | var x: string;
|
---|
114 | i: integer;
|
---|
115 | pList: TStringList;
|
---|
116 | rList: TStringList;
|
---|
117 | begin
|
---|
118 | pList := TStringList.Create;
|
---|
119 | rList := TStringList.Create;
|
---|
120 | rList.Clear;
|
---|
121 | rList := nil;
|
---|
122 | pList.Clear;
|
---|
123 | pList.Add(pOrderID);
|
---|
124 | Result := FALSE;
|
---|
125 | // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0
|
---|
126 | tCallV(rList,'ORWDBA1 ORPKGTYP',[pList]);
|
---|
127 | //returns boolean value by OrderID - True = billable
|
---|
128 | for i := 0 to rList.Count-1 do
|
---|
129 | begin
|
---|
130 | x := rList[i];
|
---|
131 | if rList[i] = BILLABLE_ORDER then
|
---|
132 | begin
|
---|
133 | Result := True;
|
---|
134 | end;
|
---|
135 | end;
|
---|
136 | end;
|
---|
137 |
|
---|
138 |
|
---|
139 | function AttachDxToOrderList(pOrderList:TStringList):TStringList;
|
---|
140 | var
|
---|
141 | i: integer;
|
---|
142 | newBillingList: TStringList;
|
---|
143 | baseDxRec: TBADxRecord;
|
---|
144 | currentOrderID: string;
|
---|
145 | currentOrderString: string;
|
---|
146 | dxString,FlagsStatsIn: string;
|
---|
147 |
|
---|
148 | begin
|
---|
149 | newBillingList:= TStringList.Create;
|
---|
150 | newBillingList.Clear;
|
---|
151 | dxString := '';
|
---|
152 | baseDxRec := nil;
|
---|
153 | baseDxRec := TBADxRecord.Create;
|
---|
154 |
|
---|
155 | InitializeNewDxRec(baseDxRec);
|
---|
156 | for i := 0 to pOrderList.Count-1 do
|
---|
157 | begin
|
---|
158 | currentOrderString := pOrderList.Strings[i];
|
---|
159 | currentOrderID := piece(pOrderList.Strings[i],';',1)+ ';1';
|
---|
160 | GetBADxListForOrder(baseDxRec, currentOrderID);
|
---|
161 | FlagsStatsIn := BAFlagsIN;
|
---|
162 | dxString := currentOrderString + '^' + piece(baseDxRec.FBADxCode,':',2);
|
---|
163 | if baseDxRec.FBASecDx1 <> '' then
|
---|
164 | dxString := dxString + '^' + piece(baseDxRec.FBASecDx1,':',2);
|
---|
165 | if baseDxRec.FBASecDx2 <> '' then
|
---|
166 | dxString := dxString + '^' + piece(baseDxRec.FBASecDx2,':',2);
|
---|
167 | if baseDxRec.FBASecDx3 <> '' then
|
---|
168 | dxString := dxString + '^' + piece(baseDxRec.FBASecDx3,':',2);
|
---|
169 |
|
---|
170 | NewBillingList.Add(dxString);
|
---|
171 | InitializeNewDxRec(baseDxRec); //HDS00004744
|
---|
172 | end;
|
---|
173 | Result := NewBillingList;
|
---|
174 | end;
|
---|
175 |
|
---|
176 |
|
---|
177 |
|
---|
178 | function rpcAddToPersonalDxList(UserDUZ:int64; DxCodes:TStringList):boolean;
|
---|
179 | //input example ien^code = 12345^306.70
|
---|
180 | begin
|
---|
181 | Result := (sCallV('ORWDBA2 ADDPDL', [UserDUZ,DxCodes])= '1');
|
---|
182 | end;
|
---|
183 |
|
---|
184 | function rpcGetPersonalDxList(UserDUZ:int64):TStringList;
|
---|
185 | var
|
---|
186 | tmplst: TStringList;
|
---|
187 | begin
|
---|
188 | tmplst := TStringList.Create;
|
---|
189 | tmplst.clear;
|
---|
190 | tCallV(tmplst, 'ORWDBA2 GETPDL', [UserDUZ]);
|
---|
191 | Result := tmplst;
|
---|
192 | end;
|
---|
193 |
|
---|
194 | function rpcDeleteFromPersonalDxList(UserDUZ:int64; Dest:TStringList):integer;
|
---|
195 | begin
|
---|
196 | uDeleteFromPDL := StrToIntDef(sCallV('ORWDBA2 DELPDL', [UserDUZ,Dest]), 0);
|
---|
197 | Result := uDeleteFromPDL;
|
---|
198 | end;
|
---|
199 |
|
---|
200 | function rpcOrderRequiresDx(pList: TStringList):boolean;
|
---|
201 | var x: string;
|
---|
202 | i,j: integer;
|
---|
203 | returnList, updatedList: TStringList;
|
---|
204 | begin
|
---|
205 | // for i := 0 to plist.count-1 do
|
---|
206 | // x := plist.strings[i];
|
---|
207 | Result := FALSE;
|
---|
208 | returnList := TStringList.Create;
|
---|
209 | updatedList := TStringList.Create;
|
---|
210 | returnList.Clear;
|
---|
211 | updatedList.Clear;
|
---|
212 | // remove deleted orderid's
|
---|
213 | if UBAGlobals.BADeltedOrders.Count > 0 then
|
---|
214 | begin
|
---|
215 | for i := 0 to UBAGlobals.BADeltedOrders.Count-1 do
|
---|
216 | x := UBAGlobals.BADeltedOrders.Strings[i];
|
---|
217 | for j := 0 to pList.Count-1 do
|
---|
218 | begin
|
---|
219 | if x = pList.Strings[j] then
|
---|
220 | continue // orderid is removed.. or skipped
|
---|
221 | else
|
---|
222 | updatedList.Add(x);
|
---|
223 | end;
|
---|
224 | end
|
---|
225 | else
|
---|
226 | updatedList.Assign(pList);
|
---|
227 | // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0
|
---|
228 | tCallV(returnList,'ORWDBA1 ORPKGTYP',[updatedList]);
|
---|
229 | //Remove NON LRMP orders from the mix(for checking for dx entry);
|
---|
230 | // BAOrderList and pList are in sync - order id....
|
---|
231 | for i := 0 to BAOrderList.Count-1 do
|
---|
232 | begin
|
---|
233 | x:= piece(returnList.Strings[i],'^',1);
|
---|
234 | if x = BILLABLE_ORDER then // change to test BA
|
---|
235 | begin
|
---|
236 | updatedBAOrderList.Add(BAOrderList[i]);
|
---|
237 | Result := TRUE;
|
---|
238 | end;
|
---|
239 | end;
|
---|
240 | end;
|
---|
241 | // returns value used to bypass Billing Aware if needed.
|
---|
242 | // turns off visual and functionality
|
---|
243 | procedure rpcSetBillingAwareSwitch(encProvider:int64; encLocation: integer);
|
---|
244 | begin
|
---|
245 | BILLING_AWARE := TRUE;
|
---|
246 | if (encProvider = 0) and not PersonHasKey(encProvider, 'PROVIDER') then
|
---|
247 | BILLING_AWARE := FALSE
|
---|
248 | else
|
---|
249 | begin
|
---|
250 | if (sCallV('ORWDBA1 BASTATUS', [nil]) = '1') then // Master switch is set "ON"
|
---|
251 | BILLING_AWARE := (sCallV('ORWDBA4 GETBAUSR', [encProvider]) = '1')
|
---|
252 | else
|
---|
253 | BILLING_AWARE := FALSE;
|
---|
254 | end;
|
---|
255 | end ;
|
---|
256 |
|
---|
257 | function rpcGetBAMasterSwStatus:boolean;
|
---|
258 | begin
|
---|
259 | Result := False;
|
---|
260 | Result := (sCallV('ORWDBA1 BASTATUS', [nil]) = '1'); // Master switch is set "ON"
|
---|
261 |
|
---|
262 |
|
---|
263 | end;
|
---|
264 |
|
---|
265 | procedure rpcSaveNurseConsultOrder(pOrderRec:TStringList);
|
---|
266 | begin
|
---|
267 | CallV('ORWDBA1 RCVORCI',[pOrderRec]);
|
---|
268 | end;
|
---|
269 |
|
---|
270 | procedure rpcSaveBillingDxEntered; // if not mandatory and user enters dx.
|
---|
271 | var
|
---|
272 | ordersWithDx,i: integer;
|
---|
273 | newBillingList: TStringList;
|
---|
274 | baseDxRec, tempDxRec: TBADxRecord;
|
---|
275 | currentOrderID, thisOrderID: string;
|
---|
276 | currentOrderString, thisRec: string;
|
---|
277 | begin
|
---|
278 | // verify Dx has been entered for orders checked for signature..
|
---|
279 | ordersWithDx := 0;
|
---|
280 | tempDxRec := TBADxRecord.Create;
|
---|
281 | UBAGlobals.InitializeNewDxRec(tempDxRec);
|
---|
282 | for i := 0 to BAOrderList.Count-1 do
|
---|
283 | begin
|
---|
284 | thisRec := BAOrderList.Strings[i];
|
---|
285 | thisOrderID := piece(thisRec,';',1) + ';1'; //rebuild orderID pass to M.
|
---|
286 | if tempDxNodeExists(thisOrderID) then
|
---|
287 | inc(ordersWithDx);
|
---|
288 | end;
|
---|
289 |
|
---|
290 | // if orders have dx enteries - save billing data.
|
---|
291 | if ordersWithDx > 0 then
|
---|
292 | begin
|
---|
293 | newBillingList:= TStringList.Create;
|
---|
294 | newBillingList.Clear;
|
---|
295 | baseDxRec := nil;
|
---|
296 | baseDxRec := TBADxRecord.Create;
|
---|
297 | InitializeNewDxRec(baseDxRec);
|
---|
298 |
|
---|
299 | try
|
---|
300 | for i := 0 to BAOrderList.Count-1 do
|
---|
301 | begin
|
---|
302 | currentOrderString := BAOrderList.Strings[i];
|
---|
303 | currentOrderID := piece(BAOrderList.Strings[i],';',1)+ ';1';
|
---|
304 | GetBADxListForOrder(baseDxRec, currentOrderID);
|
---|
305 | if baseDxRec.FBADxCode <> '' then
|
---|
306 | begin
|
---|
307 | NewBillingList.Add(currentOrderString +'^'+ baseDxRec.FBADxCode +'^'+ baseDxRec.FBASecDx1+
|
---|
308 | '^'+ baseDxRec.FBASecDx2+'^'+ baseDxRec.FBASecDx3);
|
---|
309 | end;
|
---|
310 | end;
|
---|
311 | except
|
---|
312 | on EListError do
|
---|
313 | begin
|
---|
314 | {$ifdef debug}ShowMessage('EListError in UBACore.rpcSaveBillingDxEntered()');{$endif}
|
---|
315 | raise;
|
---|
316 | end;
|
---|
317 | end;
|
---|
318 |
|
---|
319 | if NewBillingList.Count > 0 then
|
---|
320 | CallV('ORWDBA1 RCVORCI',[NewBillingList]); //1.3.10
|
---|
321 |
|
---|
322 | if Assigned(NewBillingList) then FreeAndNil(NewBillingList);
|
---|
323 | // if Assigned(UBAGlobals.BAConsultOrdersRequireDx) then UBAGlobals.BAConsultOrdersRequireDx.Clear;
|
---|
324 |
|
---|
325 | end;
|
---|
326 | end;
|
---|
327 |
|
---|
328 | procedure rpcGetSC4Orders;
|
---|
329 | begin
|
---|
330 | RPCBrokerV.Param[0].PType := literal;
|
---|
331 | RPCBrokerV.Param[0].Value := Patient.DFN;
|
---|
332 | RPCBrokerV.RemoteProcedure := 'ORWDBA1 SCLST';
|
---|
333 | CallBroker;
|
---|
334 | end;
|
---|
335 |
|
---|
336 | procedure rpcGetProviderPatientDaysDx(ProviderIEN: string;PatientIEN: string);
|
---|
337 | var i:integer;
|
---|
338 | x: string;
|
---|
339 | tmplst: TStringList;
|
---|
340 | begin
|
---|
341 | tmplst := TStringList.Create;
|
---|
342 | uDxLst := TStringList.Create;
|
---|
343 | tmplst.clear;
|
---|
344 | uDxLst.Clear;
|
---|
345 | tCallV(tmplst, 'ORWDBA2 GETDUDC', [ProviderIEN, PatientIEN]);
|
---|
346 | UBACore.UDxLst.Assign(tmplst);
|
---|
347 | tmplst.clear;
|
---|
348 | end;
|
---|
349 |
|
---|
350 |
|
---|
351 | function rpcGetTFHintData:TStringList;
|
---|
352 | begin
|
---|
353 | Result := nil;
|
---|
354 | tCallv(BATFHints,'ORWDBA3 HINTS', [nil]);
|
---|
355 | Result := BATFHints;
|
---|
356 | end;
|
---|
357 |
|
---|
358 | // call made to determine if order type is billable
|
---|
359 | // if order type NOT billable, flagged with "NA".
|
---|
360 | function rpcNonBillableOrders(pOrderList: TStringList):TStringList;
|
---|
361 | var x: string;
|
---|
362 | i: integer;
|
---|
363 | rList: TStringList;
|
---|
364 | begin
|
---|
365 | rList := TStringList.Create;
|
---|
366 | rList.Clear;
|
---|
367 | NonBillableOrderList.Clear;
|
---|
368 | Result := NonBillableOrderList;
|
---|
369 | // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0
|
---|
370 | tCallV(rList,'ORWDBA1 ORPKGTYP',[pOrderList]);
|
---|
371 | for i := 0 to rList.Count-1 do
|
---|
372 | begin
|
---|
373 | x := rList[i];
|
---|
374 | if rList[i] <> BILLABLE_ORDER then
|
---|
375 | NonBillableOrderList.Add(pOrderList[i] + U + 'NA');
|
---|
376 | end;
|
---|
377 | Result := NonBillableOrderList;
|
---|
378 | end;
|
---|
379 |
|
---|
380 |
|
---|
381 | procedure rpcBuildSCIEList(pOrderList: TList);
|
---|
382 | var AnOrder: TOrder;
|
---|
383 | OrderIDList: TStringList;
|
---|
384 | rList: TStringList;
|
---|
385 | i: integer;
|
---|
386 | begin
|
---|
387 | OrderIDList := TStringList.Create;
|
---|
388 | rList := TStringList.Create;
|
---|
389 | if Assigned(OrderListSCEI) then OrderListSCEI.Clear;
|
---|
390 | OrderIDList.Clear;
|
---|
391 | rList.Clear;
|
---|
392 | for i := 0 to pOrderList.Count -1 do
|
---|
393 | begin
|
---|
394 | AnOrder := TOrder(pOrderList.Items[i]);
|
---|
395 | OrderIDList.Add(AnOrder.ID);
|
---|
396 | end;
|
---|
397 | // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0
|
---|
398 | tCallV(rList,'ORWDBA1 ORPKGTYP',[OrderIDList]);
|
---|
399 |
|
---|
400 | for i := 0 to rList.Count-1 do
|
---|
401 | begin
|
---|
402 | if rList.Strings[i] = BILLABLE_ORDER then
|
---|
403 | OrderListSCEI.Add(OrderIDList.Strings[i]);
|
---|
404 | end;
|
---|
405 | end;
|
---|
406 |
|
---|
407 |
|
---|
408 | function OrdersHaveDx(pOrderList:TStringList):boolean;
|
---|
409 | var
|
---|
410 | i: integer;
|
---|
411 | thisOrderID: string;
|
---|
412 | thisRec: string;
|
---|
413 | tempDxRec: TBADxRecord;
|
---|
414 | begin
|
---|
415 | Result := TRUE;
|
---|
416 | tempDxRec := nil;
|
---|
417 | tempDxRec := TBADxRecord.Create;
|
---|
418 | UBAGlobals.InitializeNewDxRec(tempDxRec);
|
---|
419 |
|
---|
420 | try
|
---|
421 | for i := 0 to pOrderList.Count-1 do
|
---|
422 | begin
|
---|
423 | thisRec := pOrderList.Strings[i];
|
---|
424 | thisOrderID := piece(thisRec,';',1) + ';1'; //rebuild orderID pass to M.
|
---|
425 | if not tempDxNodeExists(thisOrderID) then
|
---|
426 | begin
|
---|
427 | Result := FALSE;
|
---|
428 | Break;
|
---|
429 | end
|
---|
430 | else
|
---|
431 | begin
|
---|
432 | GetBADxListForOrder(tempDxRec, thisOrderID);
|
---|
433 | if tempDxRec.FBADxCode = '' then
|
---|
434 | begin
|
---|
435 | Result := FALSE;
|
---|
436 | Break;
|
---|
437 | end;
|
---|
438 | end;
|
---|
439 |
|
---|
440 | end;
|
---|
441 | except
|
---|
442 | on EListError do
|
---|
443 | begin
|
---|
444 | {$ifdef debug}ShowMessage('EListError in UBACore.OrdersHaveDx()');{$endif}
|
---|
445 | raise;
|
---|
446 | end;
|
---|
447 | end;
|
---|
448 |
|
---|
449 | if Assigned(tempDxRec) then
|
---|
450 | FreeAndNil(tempDxRec);
|
---|
451 | end;
|
---|
452 |
|
---|
453 |
|
---|
454 | function BADxEntered:boolean;
|
---|
455 | var
|
---|
456 | i, orderStatus: integer;
|
---|
457 | x: string;
|
---|
458 | passList: TStringList;
|
---|
459 | holdOrderList: TStringList;
|
---|
460 | thisOrderID: string;
|
---|
461 | thisRec: string;
|
---|
462 | begin
|
---|
463 | Result := FALSE;
|
---|
464 | holdOrderList := TStringList.Create;
|
---|
465 | holdOrderList.Clear;
|
---|
466 | updatedBAOrderList := TStringList.Create;
|
---|
467 | updatedBAOrderList.Clear;
|
---|
468 | passList := TStringList.Create;
|
---|
469 | passList.Clear;
|
---|
470 | // determine which orders require a dx (lrmp- only)
|
---|
471 | // if NO then continue
|
---|
472 | // if YES, check BADxList for orders with DX enteries.
|
---|
473 | // if ok then create data string pass to M via RPC
|
---|
474 |
|
---|
475 | orderStatus := 0;
|
---|
476 | Result := true;
|
---|
477 |
|
---|
478 | try
|
---|
479 | for i := 0 to BAOrderList.Count-1 do
|
---|
480 | begin
|
---|
481 | thisRec := BAOrderList.Strings[i];
|
---|
482 | thisOrderID := piece(thisRec,';',1) + ';1'; //rebuild orderID pass to M.
|
---|
483 |
|
---|
484 | x := BAOrderList.Strings[i];
|
---|
485 | orderStatus := StrToInt(CharAt(Piece(x, ';', 2), 1)); // Order Status 1=OK, 2=DISCONTINUE
|
---|
486 | if orderStatus = integer(BAOK2SIGN) then
|
---|
487 | begin
|
---|
488 | passList.Add(piece(x,';',1));
|
---|
489 | holdOrderList.Add(x);// place holder for orders that can be signed!
|
---|
490 | end;
|
---|
491 | end;
|
---|
492 | except
|
---|
493 | on EListError do
|
---|
494 | begin
|
---|
495 | {$ifdef debug}ShowMessage('EListError in UBACore.BADxEntered()');{$endif}
|
---|
496 | raise;
|
---|
497 | end;
|
---|
498 | end;
|
---|
499 |
|
---|
500 | BAOrderList.Assign(holdOrderList); //assign signable orders to BAOrderList for further processing
|
---|
501 | holdOrderList.Clear; // CQ5025
|
---|
502 | //call with passList determine if LRMP
|
---|
503 |
|
---|
504 | if rpcOrderRequiresDx(passList) then
|
---|
505 | BAOrderList.Assign(updatedBAOrderList);
|
---|
506 |
|
---|
507 | if updatedBAOrderList.Count <= 0 then // order list reflecting orders flagged as -
|
---|
508 | begin // dx required.
|
---|
509 | Result := TRUE; // force true, no record need DX entry
|
---|
510 | rpcSaveBillingDxEntered; // save billing data for orders that may have dx enteries
|
---|
511 | Exit; //to do. clean this up... when time permitts
|
---|
512 | end
|
---|
513 | else
|
---|
514 | begin
|
---|
515 | if OrdersHaveDx(UBAGlobals.BAOrderList) then
|
---|
516 | rpcSaveBillingData(UBAGlobals.BAOrderList)
|
---|
517 | else
|
---|
518 | begin
|
---|
519 | Result := FALSE;
|
---|
520 | Exit;
|
---|
521 | end;
|
---|
522 | end;
|
---|
523 | end;
|
---|
524 |
|
---|
525 |
|
---|
526 | procedure LoadUnsignedOrderRec(var thisRetVal: TBAUnsignedBillingRec;UnsignedBillingInfo:string);
|
---|
527 | var
|
---|
528 | thisString : String;
|
---|
529 | begin
|
---|
530 | thisString := UnsignedBillingInfo;
|
---|
531 | with thisRetVal do
|
---|
532 | begin
|
---|
533 | FBAOrderID := Piece(thisString,U,1) + ';1';
|
---|
534 | FBASTSFlags := Piece(thisString,U,2);
|
---|
535 | FBADxCode := (Piece(thisString,U,4)+ U + (Piece(thisString,U,3)));
|
---|
536 | FBASecDx1 := (Piece(thisString,U,6)+ U + (Piece(thisString,U,5)));
|
---|
537 | FBASecDx2 := (Piece(thisString,U,8)+ U + (Piece(thisString,U,7)));
|
---|
538 | FBASecDx3 := (Piece(thisString,U,10)+ U + (Piece(thisString,U,9)));
|
---|
539 | // if codes are absent then get rid of '^'.
|
---|
540 | if FBADxCode = U then FBADxCode := DXREC_INIT_FIELD_VAL;
|
---|
541 | if FBASecDx1 = U then FBASecDx1 := DXREC_INIT_FIELD_VAL;
|
---|
542 | if FBASecDx2 = U then FBASecDx2 := DXREC_INIT_FIELD_VAL;
|
---|
543 | if FBASecDx3 = U then FBASecDx3 := DXREC_INIT_FIELD_VAL;
|
---|
544 | end;
|
---|
545 | end;
|
---|
546 |
|
---|
547 | procedure AttachPLTFactorsToDx(var Dest:String;ProblemRec:string);
|
---|
548 | var
|
---|
549 | TFResults: string;
|
---|
550 | thisRec: TBAPLFactorsIN;
|
---|
551 | begin
|
---|
552 | TFResults := '';
|
---|
553 | thisRec := TBAPLFactorsIN.Create;
|
---|
554 | thisRec.FBADxText := Piece(ProblemRec,'(',1);
|
---|
555 | thisRec.FBADxText := Piece(thisRec.FBADxText,U,2);
|
---|
556 | thisRec.FBADxCode := Piece(ProblemRec,U,3);
|
---|
557 | thisRec.FBASC := Piece(ProblemRec,U,5);
|
---|
558 | thisRec.FBASC_YN := Piece(ProblemRec,U,6);
|
---|
559 | thisRec.FBATreatFactors := Piece(ProblemRec,')',1);
|
---|
560 | thisRec.FBATreatFactors := Piece(thisRec.FBATreatFactors,'(',2);
|
---|
561 |
|
---|
562 | with thisRec do
|
---|
563 | begin
|
---|
564 | if StrLen(pchar(FBATreatFactors)) > 0 then // 0 Treatment Factors exist
|
---|
565 | //build string containing Problem List Treatment Factors
|
---|
566 | TFResults := ( FBADXCode + U + FBADxText + ' (' + FBASC + '/' + FBATreatFactors + ') ' )
|
---|
567 | else
|
---|
568 | if StrLen(PChar(FBASC)) > 0 then
|
---|
569 | TFResults := ( FBADxCode + U + FBADxText + ' (' + FBASC + ') ' )
|
---|
570 | else
|
---|
571 | TFResults := ( FBADxCode + U + FBADxText );
|
---|
572 | end;
|
---|
573 |
|
---|
574 | Dest := TFResults;
|
---|
575 | end;
|
---|
576 |
|
---|
577 |
|
---|
578 | // this code is to handle adding Problem List(only) TF's when selected
|
---|
579 | procedure BALoadStsFlagsAsIs(StsFlagsIN: String);
|
---|
580 | var
|
---|
581 | x: string;
|
---|
582 | begin
|
---|
583 | x:= Piece(StsFlagsIN,U,2);
|
---|
584 | UBAGlobals.SC := Copy(x,1,1);
|
---|
585 | UBAGlobals.AO := Copy(x,2,1);
|
---|
586 | UBAGlobals.IR := Copy(x,3,1);
|
---|
587 | UBAGlobals.EC := Copy(x,4,1);
|
---|
588 | UBAGlobals.MST := Copy(x,5,1);
|
---|
589 | UBAGlobals.HNC := Copy(x,6,1);
|
---|
590 | UBAGlobals.CV := Copy(x,7,1);
|
---|
591 | end;
|
---|
592 |
|
---|
593 |
|
---|
594 | // this code is to handle adding Problem List(only) TF's when selected
|
---|
595 |
|
---|
596 | procedure SetTreatmentFactors(TFactors: string);
|
---|
597 | var
|
---|
598 | strTFactors : string;
|
---|
599 | strFlagsOut: string;
|
---|
600 | FlagsIN : TStringList;
|
---|
601 | Idx: string;
|
---|
602 | i : integer;
|
---|
603 | begin
|
---|
604 | UBAGlobals.BAFlagsOUT := TStringList.Create;
|
---|
605 | UBAGlobals.BAFlagsOUT.Clear;
|
---|
606 | FlagsIN := TStringList.Create;
|
---|
607 | FlagsIN.Clear;
|
---|
608 | FlagsIN := UBAGlobals.PLFactorsIndexes;
|
---|
609 |
|
---|
610 | for i:= 0 to FlagsIN.Count-1 do
|
---|
611 | begin
|
---|
612 | BALoadStsFlagsAsIs(FlagsIN.Strings[i]);
|
---|
613 | IDX := Piece(FlagsIN.Strings[i],U,1);
|
---|
614 |
|
---|
615 | strTFactors := TFactors;
|
---|
616 |
|
---|
617 | if UBAGlobals.SC <> 'N' then
|
---|
618 | if StrPos(PChar(strTFactors),PChar(SERVICE_CONNECTED)) <> nil then
|
---|
619 | UBAGlobals.SC := 'C' ;
|
---|
620 |
|
---|
621 | if UBAGlobals.SC <> 'N' then
|
---|
622 | if StrPos(PChar(strTFactors),PChar(NOT_SERVICE_CONNECTED)) <> nil then
|
---|
623 | UBAGlobals.SC := 'U';
|
---|
624 |
|
---|
625 | if UBAGlobals.AO <>'N' then
|
---|
626 | if StrPos(PChar(strTFactors),PChar(AGENT_ORANGE)) <> nil then
|
---|
627 | UBAGlobals.AO := 'C';
|
---|
628 |
|
---|
629 | if UBAGlobals.IR <>'N' then
|
---|
630 | if StrPos(PChar(strTFactors),PChar(IONIZING_RADIATION)) <> nil then
|
---|
631 | UBAGlobals.IR := 'C';
|
---|
632 |
|
---|
633 | if UBAGlobals.EC <>'N' then
|
---|
634 | if StrPos(PChar(strTFactors),PChar(ENVIRONMENTAL_CONTAM)) <> nil then
|
---|
635 | UBAGlobals.EC := 'C';
|
---|
636 |
|
---|
637 | if UBAGlobals.MST <>'N' then
|
---|
638 | if StrPos(PChar(strTFactors),PChar(MILITARY_SEXUAL_TRAUMA)) <> nil then
|
---|
639 | UBAGlobals.MST := 'C';
|
---|
640 |
|
---|
641 | if UBAGlobals.CV <>'N' then
|
---|
642 | if StrPos(PChar(strTFactors),PChar(COMBAT_VETERAN)) <> nil then
|
---|
643 | UBAGlobals.CV := 'C';
|
---|
644 |
|
---|
645 | if UBAGlobals.HNC <>'N' then
|
---|
646 | if StrPos(PChar(strTFactors),PChar(HEAD_NECK_CANCER)) <> nil then
|
---|
647 | UBAGlobals.HNC := 'C';
|
---|
648 |
|
---|
649 | // Build Treatment Factor List to be passed to fOrdersSign form
|
---|
650 | strFlagsOut := (SC + AO + IR + EC + MST + HNC + CV);
|
---|
651 | UBAGlobals.BAFlagsOUT.Add(IDX + '^' + strFlagsOut );
|
---|
652 | end;
|
---|
653 | end;
|
---|
654 |
|
---|
655 |
|
---|
656 | function StripTFactors(FactorsIN: string):string;
|
---|
657 | var strDxCode,strDxName:string;
|
---|
658 | begin
|
---|
659 | Result := '';
|
---|
660 | strDxCode := Piece(FactorsIN,U,2);
|
---|
661 | strDxName := Piece(FactorsIN,'(',1);
|
---|
662 | Result := (strDxName + U + strDxCode);
|
---|
663 | end;
|
---|
664 |
|
---|
665 | function AddProviderPatientDaysDx(Dest: TStringList; ProviderIEN: string;PatientIEN: string) : TStringList;
|
---|
666 | var i:integer;
|
---|
667 | x: string;
|
---|
668 | tmplst: TStringList;
|
---|
669 | begin
|
---|
670 | tmplst := TStringList.Create;
|
---|
671 | tmplst.clear;
|
---|
672 | tCallV(tmplst, 'ORWDBA2 GETDUDC', [ProviderIEN, PatientIEN]);
|
---|
673 |
|
---|
674 | try
|
---|
675 | for i := 0 to tmplst.count-1 do
|
---|
676 | x := tmplst.Strings[i];
|
---|
677 | except
|
---|
678 | on EListError do
|
---|
679 | begin
|
---|
680 | {$ifdef debug}ShowMessage('EListError in UBACore.AddProviderPatientDaysDx()');{$endif}
|
---|
681 | raise;
|
---|
682 | end;
|
---|
683 | end;
|
---|
684 |
|
---|
685 | Result := tmplst;
|
---|
686 | end;
|
---|
687 |
|
---|
688 | // UBAGlobals.NonBillableOrderList must be populated prior to calling this function.
|
---|
689 | // call rpcNonBillableOrders to populate List.
|
---|
690 | function IsOrderBillable(pOrderID: string):boolean ;
|
---|
691 | var
|
---|
692 | i: integer;
|
---|
693 | currOrderID: string;
|
---|
694 | matchOrderID : string;
|
---|
695 |
|
---|
696 | begin
|
---|
697 | Result := TRUE; // = Billable
|
---|
698 | currOrderID := PrepOrderID(pOrderID);
|
---|
699 | if Piece(pOrderID,';',2) = DISCONTINUED_ORDER THEN
|
---|
700 | begin
|
---|
701 | Result := FALSE;
|
---|
702 | Exit;
|
---|
703 | end;
|
---|
704 | try
|
---|
705 | for i := 0 to UBAGlobals.NonBillableOrderList.Count -1 do
|
---|
706 | begin
|
---|
707 | matchOrderID := PrepOrderID( (Piece(UBAGlobals.NonBillableOrderList.Strings[i],U,1)) );
|
---|
708 | if currOrderID = matchOrderID then
|
---|
709 | Result := FALSE //= Non Billable
|
---|
710 | end;
|
---|
711 | except
|
---|
712 | on EListError do
|
---|
713 | begin
|
---|
714 | {$ifdef debug}ShowMessage('EListError in UBACore.IsOrderBillable()');{$endif}
|
---|
715 | raise;
|
---|
716 | end;
|
---|
717 | end;
|
---|
718 | end;
|
---|
719 |
|
---|
720 |
|
---|
721 | function OrderRequiresSCEI(pOrderID: string):boolean;
|
---|
722 | var i:integer;
|
---|
723 |
|
---|
724 | begin
|
---|
725 | Result := False;
|
---|
726 |
|
---|
727 | try
|
---|
728 | for i := 0 to UBAGlobals.OrderListSCEI.Count-1 do
|
---|
729 | begin
|
---|
730 | if pOrderID = UBAGlobals.OrderListSCEI.Strings[i] then
|
---|
731 | begin
|
---|
732 | Result := True;
|
---|
733 | Break;
|
---|
734 | end;
|
---|
735 | end;
|
---|
736 | except
|
---|
737 | on EListError do
|
---|
738 | begin
|
---|
739 | {$ifdef debug}ShowMessage('EListError in UBACore.OrderRequiresSCEI()');{$endif}
|
---|
740 | raise;
|
---|
741 | end;
|
---|
742 | end;
|
---|
743 | end;
|
---|
744 |
|
---|
745 | procedure SaveUnsignedOrders(pOrderRec:String);
|
---|
746 | begin
|
---|
747 | // save all unsigned orders, keeping freview and fordersSign in sync
|
---|
748 | // this change may have an impact on response time??????
|
---|
749 | // change from save orders with dx to save all. 06/24/04
|
---|
750 | // / if not clear treatment factors for order is non cidc
|
---|
751 | uBAGlobals.UnsignedOrders.Add(pOrderRec);
|
---|
752 |
|
---|
753 | end;
|
---|
754 |
|
---|
755 | function rpcRetrieveSelectedOrderInfo(pOrderIDList: TStringList):TStringList;
|
---|
756 | var
|
---|
757 | rList : TStringList;
|
---|
758 | newList:TStringList;
|
---|
759 | i: integer;
|
---|
760 | x: string;
|
---|
761 | begin
|
---|
762 | rList := TStringList.Create;
|
---|
763 | newList := TStringList.Create;
|
---|
764 | if Assigned(rList) then rList.Clear;
|
---|
765 | if Assigned(newList) then newList.Clear;
|
---|
766 |
|
---|
767 | for i := 0 to pOrderIDList.Count-1 do
|
---|
768 | begin
|
---|
769 | newList.Add(Piece(pOrderIDList.Strings[i],';',1));
|
---|
770 | x := newlist.strings[i];
|
---|
771 | end;
|
---|
772 | if newList.Count > 0 then
|
---|
773 | tCallV(rList,'ORWDBA4 GETTFCI',[newList]);
|
---|
774 | Result := rList;
|
---|
775 |
|
---|
776 |
|
---|
777 | end;
|
---|
778 |
|
---|
779 | procedure BuildSaveUnsignedList(pOrderList: TStringList);
|
---|
780 | var
|
---|
781 | thisList: TStringList;
|
---|
782 | rList: TStringList;
|
---|
783 | i:integer;
|
---|
784 | x: string;
|
---|
785 | begin
|
---|
786 |
|
---|
787 | thisList := TStringList.Create;
|
---|
788 | rList := TStringList.Create;
|
---|
789 | if Assigned(rList) then rList.Clear;
|
---|
790 | if Assigned(thisList)then thisList.Clear;
|
---|
791 | for i := 0 to pOrderList.Count -1 do
|
---|
792 | x := pOrderList.Strings[i];
|
---|
793 | rpcSaveBillingData(pOrderList); // save unsigned info to be displayed when recalled at later time
|
---|
794 | end;
|
---|
795 |
|
---|
796 | function rpcGetUnsignedOrdersBillingData(pOrderList: TStringList):TStringList;
|
---|
797 | var
|
---|
798 | i:integer;
|
---|
799 | newList:TStringList;
|
---|
800 | rList:TStringList;
|
---|
801 | begin
|
---|
802 | newList := TStringList.Create;
|
---|
803 | rList := TStringList.Create;
|
---|
804 | if Assigned(newList) then newList.Clear;
|
---|
805 | if Assigned(rList) then rList.Clear;
|
---|
806 | Result := rList;
|
---|
807 |
|
---|
808 | if pOrderList.Count = 0 then Exit;
|
---|
809 | for i := 0 to pOrderList.Count-1 do
|
---|
810 | begin
|
---|
811 | newList.Add(Piece(pOrderList.Strings[i],';',1));
|
---|
812 | end;
|
---|
813 | tCallV(rList,'ORWDBA4 GETTFCI',[newList]);
|
---|
814 | Result := rList;
|
---|
815 | end;
|
---|
816 |
|
---|
817 | procedure CompleteUnsignedBillingInfo(pOrderList:TStringList);
|
---|
818 | var
|
---|
819 | i: integer;
|
---|
820 | RecOut : TBADxRecord;
|
---|
821 | copyList: TStringList;
|
---|
822 | begin
|
---|
823 | copyList := TStringList.Create;
|
---|
824 | if Assigned(copyList) then copyList.Clear;
|
---|
825 |
|
---|
826 | if Assigned(BAUnSignedOrders) then BAUnSignedOrders.Clear;
|
---|
827 |
|
---|
828 | if not Assigned(UBAGlobals.UnsignedBillingRec) then
|
---|
829 | begin
|
---|
830 | UBAGlobals.UnSignedBillingRec := UBAGlobals.TBAUnsignedBillingRec.Create;
|
---|
831 | UBAGlobals.InitializeUnsignedOrderRec(UBAGlobals.UnsignedBillingRec);
|
---|
832 | end;
|
---|
833 |
|
---|
834 | UBAGlobals.InitializeUnsignedOrderRec(UnsignedBillingRec);
|
---|
835 |
|
---|
836 | try
|
---|
837 | for i := 0 to pOrderList.Count-1 do
|
---|
838 | begin
|
---|
839 | LoadUnsignedOrderRec(UBAGlobals.UnsignedBillingRec, pOrderList.Strings[i]);
|
---|
840 | if Not UBAGlobals.tempDxNodeExists(UnsignedBillingRec.FBAOrderID) then
|
---|
841 | begin
|
---|
842 | SimpleAddTempDxList(UnSignedBillingRec.FBAOrderID);
|
---|
843 | RecOut := TBADxRecord.Create;
|
---|
844 | RecOut.FExistingRecordID := UnSignedBillingRec.FBAOrderID;
|
---|
845 | RecOut.FBADxCode := UnsignedBillingRec.FBADxCode;
|
---|
846 | RecOut.FBASecDx1 := UnsignedBillingRec.FBASecDx1;
|
---|
847 | RecOut.FBASecDx2 := UnsignedBillingRec.FBASecDx2;
|
---|
848 | RecOut.FBASecDx3 := UnsignedBillingRec.FBASecDx3;
|
---|
849 | RecOut.FTreatmentFactors := UnSignedBillingRec.FBASTSFlags;
|
---|
850 | PutBADxListForOrder(RecOut, RecOut.FExistingRecordID);
|
---|
851 | UBAGlobals.BAUnSignedOrders.Add(UnSignedBillingRec.FBAOrderID + '^' + UnSignedBillingRec.FBASTSFlags);
|
---|
852 | end
|
---|
853 | else
|
---|
854 | begin
|
---|
855 | RecOut := TBADxRecord.Create;
|
---|
856 | if tempDxNodeExists(UnSignedBillingRec.FBAOrderID) then
|
---|
857 | begin
|
---|
858 | GetBADxListForOrder(RecOut, UnSignedBillingRec.FBAOrderID); //load data from source
|
---|
859 | copyList.Add(UnSignedBillingRec.FBAOrderID + '^' + UnSignedBillingRec.FBASTSFlags);
|
---|
860 | BuildSaveUnsignedList(copyList);
|
---|
861 | end;
|
---|
862 | end;
|
---|
863 | end;
|
---|
864 | except
|
---|
865 | on EListError do
|
---|
866 | begin
|
---|
867 | {$ifdef debug}ShowMessage('EListError in UBACore.CompleteUnsignedBillingInfo()');{$endif}
|
---|
868 | raise;
|
---|
869 | end;
|
---|
870 | end;
|
---|
871 | end;
|
---|
872 |
|
---|
873 | function GetUnsignedOrderFlags(pOrderID: string; pFlagList: TStringList):string;
|
---|
874 | var
|
---|
875 | i: integer;
|
---|
876 | begin
|
---|
877 | Result := '';
|
---|
878 | try
|
---|
879 | for i := 0 to pFlagList.Count-1 do
|
---|
880 | begin
|
---|
881 | if pOrderID = Piece(pFlagList.Strings[i],U,1) then
|
---|
882 | begin
|
---|
883 | Result := Piece(pFlagList.Strings[i],U,2); // STSFlags
|
---|
884 | Break;
|
---|
885 | end;
|
---|
886 | end;
|
---|
887 | except
|
---|
888 | on EListError do
|
---|
889 | begin
|
---|
890 | {$ifdef debug}ShowMessage('EListError in UBACore.GetUnsignedOrderFlags()');{$endif}
|
---|
891 | raise;
|
---|
892 | end;
|
---|
893 | end;
|
---|
894 |
|
---|
895 | end;
|
---|
896 |
|
---|
897 | // BuildTFHintRec is meant to run once, first user of the session
|
---|
898 | // contains the information to be displayed while mouse-over in fOrdersSign and fReview.
|
---|
899 | procedure BuildTFHintRec;
|
---|
900 | var
|
---|
901 | hintList :TStringList;
|
---|
902 | i: integer;
|
---|
903 | x: string;
|
---|
904 | begin
|
---|
905 | hintList := TStringList.Create;
|
---|
906 | if Assigned(hintList) then hintList.Clear;
|
---|
907 | hintList := rpcGetTFHintData;
|
---|
908 | if hintList.Count > 0 then UBAGlobals.BAFactorsRec.FBAFactorActive := TRUE;
|
---|
909 |
|
---|
910 | try
|
---|
911 | for i := 0 to hintList.Count -1 do
|
---|
912 | begin
|
---|
913 | x := hintList.Strings[i];
|
---|
914 | if piece(x,U,1) = SERVICE_CONNECTED then
|
---|
915 | begin
|
---|
916 | if piece(x,U,2) = '1' then
|
---|
917 | UBAGlobals.BAFactorsRec.FBAFactorSC := Piece(x,U,3)
|
---|
918 | else
|
---|
919 | UBAGlobals.BAFactorsRec.FBAFactorSC := ( UBAGlobals.BAFactorsRec.FBAFactorSC + CRLF + Piece(x,U,3) );
|
---|
920 | end
|
---|
921 | else
|
---|
922 | if piece(x,U,1) = AGENT_ORANGE then
|
---|
923 | begin
|
---|
924 | if piece(x,U,2) = '1' then
|
---|
925 | UBAGlobals.BAFactorsRec.FBAFactorAO := Piece(x,U,3)
|
---|
926 | else
|
---|
927 | UBAGlobals.BAFactorsRec.FBAFactorAO := (UBAGlobals.BAFactorsRec.FBAFactorAO + CRLF + Piece(x,U,3) );
|
---|
928 | end
|
---|
929 | else
|
---|
930 | if piece(x,U,1) = IONIZING_RADIATION then
|
---|
931 | begin
|
---|
932 | if piece(x,U,2) = '1' then
|
---|
933 | UBAGlobals.BAFactorsRec.FBAFactorIR := Piece(x,U,3)
|
---|
934 | else
|
---|
935 | UBAGlobals.BAFactorsRec.FBAFactorIR := (UBAGlobals.BAFactorsRec.FBAFactorIR + CRLF + Piece(x,U,3) );
|
---|
936 | end
|
---|
937 | else
|
---|
938 | if piece(x,U,1) = ENVIRONMENTAL_CONTAM then
|
---|
939 | begin
|
---|
940 | if piece(x,U,2) = '1' then
|
---|
941 | UBAGlobals.BAFactorsRec.FBAFactorEC := Piece(x,U,3)
|
---|
942 | else
|
---|
943 | UBAGlobals.BAFactorsRec.FBAFactorEC := (UBAGlobals.BAFactorsRec.FBAFactorEC + CRLF + Piece(x,U,3) );
|
---|
944 | end
|
---|
945 | else
|
---|
946 | if piece(x,U,1) = HEAD_NECK_CANCER then
|
---|
947 | begin
|
---|
948 | if piece(x,U,2) = '1' then
|
---|
949 | UBAGlobals.BAFactorsRec.FBAFactorHNC := Piece(x,U,3)
|
---|
950 | else
|
---|
951 | UBAGlobals.BAFactorsRec.FBAFactorHNC := (UBAGlobals.BAFactorsRec.FBAFactorHNC + CRLF + Piece(x,U,3) );
|
---|
952 | end
|
---|
953 | else
|
---|
954 | if piece(x,U,1) = MILITARY_SEXUAL_TRAUMA then
|
---|
955 | begin
|
---|
956 | if piece(x,U,2) = '1' then
|
---|
957 | UBAGlobals.BAFactorsRec.FBAFactorMST := Piece(x,U,3)
|
---|
958 | else
|
---|
959 | UBAGlobals.BAFactorsRec.FBAFactorMST := (UBAGlobals.BAFactorsRec.FBAFactorMST + CRLF + Piece(x,U,3) );
|
---|
960 | end
|
---|
961 | else
|
---|
962 | if piece(x,U,1) = COMBAT_VETERAN then
|
---|
963 | begin
|
---|
964 | if piece(x,U,2) = '1' then
|
---|
965 | UBAGlobals.BAFactorsRec.FBAFactorCV := Piece(x,U,3)
|
---|
966 | else
|
---|
967 | UBAGlobals.BAFactorsRec.FBAFactorCV := (UBAGlobals.BAFactorsRec.FBAFactorCV + CRLF + Piece(x,U,3) );
|
---|
968 | end;
|
---|
969 | end;
|
---|
970 | except
|
---|
971 | on EListError do
|
---|
972 | begin
|
---|
973 | {$ifdef debug}ShowMessage('EListError in UBACore.BuileTFHintRec()');{$endif}
|
---|
974 | raise;
|
---|
975 | end;
|
---|
976 | end;
|
---|
977 | end;
|
---|
978 |
|
---|
979 |
|
---|
980 | function IsAllOrdersNA(pOrderList:TStringList):boolean;
|
---|
981 | var
|
---|
982 | i,j:integer;
|
---|
983 | rList: TStringList;
|
---|
984 | begin
|
---|
985 | rList := TStringList.Create;
|
---|
986 | if Assigned(rList) then rList.Clear;
|
---|
987 | Result := True;// disables dx button
|
---|
988 | for j := 0 to pOrderList.Count-1 do
|
---|
989 | begin
|
---|
990 | // code added to allow consult orders that are not cidc but require dx, dx can be edited.
|
---|
991 | if tempDxNodeExists(pOrderList.Strings[j]) then
|
---|
992 | begin
|
---|
993 | Result := False;
|
---|
994 | Exit;
|
---|
995 | end
|
---|
996 | else
|
---|
997 | if Piece(pOrderList.Strings[j],';',2) = DISCONTINUED_ORDER then
|
---|
998 | begin
|
---|
999 | Result := True;
|
---|
1000 | Exit;
|
---|
1001 | end;
|
---|
1002 |
|
---|
1003 | end;
|
---|
1004 | // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0
|
---|
1005 | tCallV(rList,'ORWDBA1 ORPKGTYP',[pOrderList]);
|
---|
1006 |
|
---|
1007 | for i := 0 to rList.Count-1 do
|
---|
1008 | begin
|
---|
1009 | if rList.Strings[i] = BILLABLE_ORDER then
|
---|
1010 | begin
|
---|
1011 | Result := False;
|
---|
1012 | Break;
|
---|
1013 | end;
|
---|
1014 | end;
|
---|
1015 | end;
|
---|
1016 |
|
---|
1017 | function PrepOrderID(pOrderID:String): String;
|
---|
1018 | var
|
---|
1019 | newOrderID: String;
|
---|
1020 | begin
|
---|
1021 | newOrderID := '';
|
---|
1022 | if pos(';',pOrderID) > 0 then
|
---|
1023 | newOrderID := Piece(pOrderID,';',1)
|
---|
1024 | else
|
---|
1025 | newOrderID := pOrderID ;
|
---|
1026 |
|
---|
1027 | Result := newOrderID;
|
---|
1028 | end;
|
---|
1029 |
|
---|
1030 | procedure ClearSelectedOrderDiagnoses(pOrderIDList: TStringList);
|
---|
1031 | var
|
---|
1032 | RecOut: TBADXRecord;
|
---|
1033 | i: integer;
|
---|
1034 | begin
|
---|
1035 | try
|
---|
1036 | for i := 0 to pOrderIDList.Count-1 do
|
---|
1037 | begin
|
---|
1038 | if UBAGlobals.tempDxNodeExists(pOrderIDList.Strings[i]) then
|
---|
1039 | begin
|
---|
1040 | RecOut := TBADxRecord.Create;
|
---|
1041 | GetBADxListForOrder(RecOut, pOrderIDList.Strings[i]);
|
---|
1042 | RecOut.FOrderID := RecOut.FOrderID;
|
---|
1043 | RecOut.FBADxCode := DXREC_INIT_FIELD_VAL;
|
---|
1044 | RecOut.FBASecDx1 := DXREC_INIT_FIELD_VAL;
|
---|
1045 | RecOut.FBASecDx2 := DXREC_INIT_FIELD_VAL;
|
---|
1046 | RecOut.FBASecDx3 := DXREC_INIT_FIELD_VAL;
|
---|
1047 | PutBADxListForOrder(RecOut, pOrderIDList.Strings[i]);
|
---|
1048 | frmReview.lstReview.Refresh;
|
---|
1049 | end;
|
---|
1050 | end;
|
---|
1051 | except
|
---|
1052 | on EListError do
|
---|
1053 | begin
|
---|
1054 | {$ifdef debug}ShowMessage('EListError in UBACore.ClearSelectedORdersDiagnoses()');{$endif}
|
---|
1055 | raise;
|
---|
1056 | end;
|
---|
1057 | end;
|
---|
1058 | end;
|
---|
1059 |
|
---|
1060 | procedure LoadConsultOrderRec(var thisRetVal: TBAConsultOrderRec; pOrderID: String; pDxList: TStringList);
|
---|
1061 | var
|
---|
1062 | thisString, thisFlags:String;
|
---|
1063 | dx1,dx2,dx3,dx4: string;
|
---|
1064 | i: integer;
|
---|
1065 | begin
|
---|
1066 | thisFlags := '';
|
---|
1067 | dx1 := '';
|
---|
1068 | dx2 := '';
|
---|
1069 | dx3 := '';
|
---|
1070 | dx4 := '';
|
---|
1071 | UBAGlobals.BAConsultDxList.Sort;
|
---|
1072 |
|
---|
1073 | try
|
---|
1074 | for i := 0 to UBAGlobals.BAConsultDxList.Count -1 do
|
---|
1075 | begin
|
---|
1076 | thisString := UBAGlobals.BAConsultDxList[i];
|
---|
1077 |
|
---|
1078 | if i = 0 then
|
---|
1079 | begin
|
---|
1080 | if pos( '(', thisString) > 0 then
|
---|
1081 | begin
|
---|
1082 | thisFlags := Piece(thisString,'(',2);
|
---|
1083 | thisFlags := Piece(thisFlags,')',1);
|
---|
1084 | UBAGlobals.BAConsultPLFlags.Add(pOrderID + U + thisFlags);
|
---|
1085 | dx1 := Piece(thisString,U,2);
|
---|
1086 | dx1 := Piece(dx1,'(',1) + U + Piece(thisString,':',2);
|
---|
1087 | end
|
---|
1088 | else
|
---|
1089 | begin
|
---|
1090 | dx1 := Piece(thisString,U,2);
|
---|
1091 | dx1 := Piece(dx1,':',1)+ U + Piece(thisString,':',2);
|
---|
1092 | end
|
---|
1093 | end
|
---|
1094 | else
|
---|
1095 | if i = 1 then
|
---|
1096 | begin
|
---|
1097 | if pos( '(', thisString) > 0 then
|
---|
1098 | begin
|
---|
1099 | dx2 := Piece(thisString,U,2);
|
---|
1100 | dx2 := Piece(dx2,'(',1)+ U + Piece(thisString,':',2);
|
---|
1101 | end
|
---|
1102 | else
|
---|
1103 | begin
|
---|
1104 | dx2 := Piece(thisString,U,2);
|
---|
1105 | dx2 := Piece(dx2,':',1)+ U + Piece(thisString,':',2);
|
---|
1106 | end
|
---|
1107 | end
|
---|
1108 | else
|
---|
1109 | if i = 2 then
|
---|
1110 | begin
|
---|
1111 | if pos( '(', thisString) > 0 then
|
---|
1112 | begin
|
---|
1113 | dx3 := Piece(thisString,U,2);
|
---|
1114 | dx3 := Piece(dx3,'(',1)+ U + Piece(thisString,':',2);
|
---|
1115 | end
|
---|
1116 | else
|
---|
1117 | begin
|
---|
1118 | dx3 := Piece(thisString,U,2);
|
---|
1119 | dx3 := Piece(dx3,':',1)+ U + Piece(thisString,':',2);
|
---|
1120 | end
|
---|
1121 | end
|
---|
1122 | else
|
---|
1123 | if i = 3 then
|
---|
1124 | begin
|
---|
1125 | if pos( '(', thisString) > 0 then
|
---|
1126 | begin
|
---|
1127 | dx4 := Piece(thisString,U,2);
|
---|
1128 | dx4 := Piece(dx4,'(',1)+ U + Piece(thisString,':',2);
|
---|
1129 | end
|
---|
1130 | else
|
---|
1131 | begin
|
---|
1132 | dx4 := Piece(thisString,U,2);
|
---|
1133 | dx4 := Piece(dx4,':',1)+ U + Piece(thisString,':',2);
|
---|
1134 | end;
|
---|
1135 | end;
|
---|
1136 | end;
|
---|
1137 | except
|
---|
1138 | on EListError do
|
---|
1139 | begin
|
---|
1140 | {$ifdef debug}ShowMessage('EListError in UBACore.LoadConsultOrderRec()');{$endif}
|
---|
1141 | raise;
|
---|
1142 | end;
|
---|
1143 | end;
|
---|
1144 |
|
---|
1145 | with thisRetVal do
|
---|
1146 | begin
|
---|
1147 | FBAOrderID := pOrderID;
|
---|
1148 | FBATreatmentFactors:= thisFlags;
|
---|
1149 | FBADxCode := dx1;
|
---|
1150 | FBASecDx1 := dx2;
|
---|
1151 | FBASecDx2 := dx3;
|
---|
1152 | FBASecDx3 := dx4;
|
---|
1153 | end;
|
---|
1154 | end;
|
---|
1155 |
|
---|
1156 | procedure LoadTFactorsInRec(var thisRetVal: TBATreatmentFactorsInRec; pOrderID:string; pEligible: string; pTFactors:string);
|
---|
1157 | begin
|
---|
1158 | with thisRetVal do
|
---|
1159 | begin
|
---|
1160 | FBAOrderID := pOrderID;
|
---|
1161 | FBAEligible := pEligible;
|
---|
1162 | FBATFactors := pTFactors;
|
---|
1163 | end;
|
---|
1164 | end;
|
---|
1165 |
|
---|
1166 | procedure CompleteConsultOrderRec(pOrderID: string; pDxList: TStringList);
|
---|
1167 | var
|
---|
1168 | RecOut : TBADxRecord;
|
---|
1169 | TfFlags,dxRec: string;
|
---|
1170 | orderList : TStringList;
|
---|
1171 | tmpOrderList: TStringList;
|
---|
1172 | begin
|
---|
1173 | orderList := TStringList.Create;
|
---|
1174 | tmpOrderList := TStringList.Create;
|
---|
1175 | orderList.Clear;
|
---|
1176 | tmpOrderList.Clear;
|
---|
1177 | if not Assigned(uBAGlobals.ConsultOrderRec)then
|
---|
1178 | begin
|
---|
1179 | UBAGlobals.ConsultOrderRec := UBAGlobals.TBAConsultOrderRec.Create;
|
---|
1180 | InitializeConsultOrderRec(UBAGlobals.ConsultOrderRec);
|
---|
1181 | end
|
---|
1182 | else
|
---|
1183 | InitializeConsultOrderRec(UBAGlobals.ConsultOrderRec);
|
---|
1184 | // call rpc to load list with boolean values based on orders package type.
|
---|
1185 | UBAGlobals.NonBillableOrderList.Clear;
|
---|
1186 | tmpOrderList.Add(UBAGLobals.BAOrderID);
|
---|
1187 | rpcNonBillableOrders(tmpOrderList);
|
---|
1188 | if IsOrderBillable(uBAGlobals.BAOrderID) then
|
---|
1189 | begin
|
---|
1190 | if not UBAGlobals.tempDxNodeExists(uBAGlobals.BAOrderID) then
|
---|
1191 | begin
|
---|
1192 | LoadConsultOrderRec(UBAGlobals.ConsultOrderRec,UBAGlobals.BAOrderID,uBAGlobals.BAConsultDxList);
|
---|
1193 | if NOT UBAGlobals.tempDxNodeExists(pOrderID) then
|
---|
1194 | SimpleAddTempDxList(pOrderID);
|
---|
1195 | RecOut := TBADxRecord.Create;
|
---|
1196 | RecOut.FExistingRecordID := pOrderID;
|
---|
1197 | RecOut.FBADxCode := ConsultOrderRec.FBADxCode;
|
---|
1198 | RecOut.FBASecDx1 := ConsultOrderRec.FBASecDx1;
|
---|
1199 | RecOut.FBASecDx2 := ConsultOrderRec.FBASecDx2;
|
---|
1200 | RecOut.FBASecDx3 := ConsultOrderRec.FBASecDx3;
|
---|
1201 | RecOut.FTreatmentFactors := ConsultOrderRec.FBATreatmentFactors;
|
---|
1202 | PutBADxListForOrder(RecOut, RecOut.FExistingRecordID);
|
---|
1203 | // HDS00003380
|
---|
1204 | if IsUserNurseProvider(User.DUZ) then
|
---|
1205 | begin
|
---|
1206 | dxRec := BuildConsultDxRec(ConsultOrderRec);
|
---|
1207 | orderList.Add(RecOut.FExistingRecordID);
|
---|
1208 | TfFlags := Piece(GetPatientTFactors(orderList),U,2);
|
---|
1209 | orderList.Clear;
|
---|
1210 | if strLen(PChar(dxRec)) > 0 then
|
---|
1211 | orderList.Add(RecOut.FExistingRecordID +TfFlags + '^'+ BuildConsultDxRec(ConsultOrderRec) )
|
---|
1212 | else
|
---|
1213 | orderList.Add(RecOut.FExistingRecordID +TfFlags);
|
---|
1214 | rpcSaveBillingData(OrderList); // save unsigned info to be displayed when re
|
---|
1215 | end;
|
---|
1216 | end;
|
---|
1217 | end;
|
---|
1218 | end;
|
---|
1219 |
|
---|
1220 | function GetConsultFlags(pOrderID:String; pFlagList:TStringList;FlagsAsIs:string):string;
|
---|
1221 | var
|
---|
1222 | i: integer; //add code to match order id.....
|
---|
1223 | begin
|
---|
1224 | Result := '';
|
---|
1225 | for i := 0 to pFlagList.Count -1 do
|
---|
1226 | begin
|
---|
1227 | if pOrderID = Piece(pFlagList.Strings[i],U,1) then
|
---|
1228 | begin
|
---|
1229 | Result := SetConsultFlags( Piece(pFlagList.Strings[i],U,2), FlagsAsIs);
|
---|
1230 | break;
|
---|
1231 | end;
|
---|
1232 | end;
|
---|
1233 |
|
---|
1234 | end;
|
---|
1235 |
|
---|
1236 | function SetConsultFlags(pPLFactors: string; pFlagsAsIs:string):string; // return updated flags.
|
---|
1237 | var
|
---|
1238 | strFlagsAsIs: string;
|
---|
1239 | strTFactors: string;
|
---|
1240 | strFlagsOut,x: string;
|
---|
1241 |
|
---|
1242 | begin
|
---|
1243 | strFlagsAsIs := pFlagsAsIs; // flags from pims
|
---|
1244 | strTFactors := pPLFactors; // value selected from problem list
|
---|
1245 | strFlagsOut := ''; // flags updated with selected values from problem list
|
---|
1246 | x := strFlagsAsIs;
|
---|
1247 | Result := '';
|
---|
1248 |
|
---|
1249 | UBAGlobals.SC := Copy(x,1,1);
|
---|
1250 | UBAGlobals.AO := Copy(x,2,1);
|
---|
1251 | UBAGlobals.IR := Copy(x,3,1);
|
---|
1252 | UBAGlobals.EC := Copy(x,4,1);
|
---|
1253 | UBAGlobals.MST := Copy(x,5,1);
|
---|
1254 | UBAGlobals.HNC := Copy(x,6,1);
|
---|
1255 | UBAGlobals.CV := Copy(x,7,1); // load factors to global vars;
|
---|
1256 |
|
---|
1257 | if UBAGlobals.SC <> 'N' then
|
---|
1258 | if StrPos(PChar(strTFactors),PChar(SERVICE_CONNECTED)) <> nil then
|
---|
1259 | UBAGlobals.SC := 'C' ;
|
---|
1260 |
|
---|
1261 | if UBAGlobals.SC <> 'N' then
|
---|
1262 | if StrPos(PChar(strTFactors),PChar(NOT_SERVICE_CONNECTED)) <> nil then
|
---|
1263 | UBAGlobals.SC := 'U';
|
---|
1264 |
|
---|
1265 | if UBAGlobals.AO <>'N' then
|
---|
1266 | if StrPos(PChar(strTFactors),PChar(AGENT_ORANGE)) <> nil then
|
---|
1267 | UBAGlobals.AO := 'C';
|
---|
1268 |
|
---|
1269 | if UBAGlobals.IR <>'N' then
|
---|
1270 | if StrPos(PChar(strTFactors),PChar(IONIZING_RADIATION)) <> nil then
|
---|
1271 | UBAGlobals.IR := 'C';
|
---|
1272 |
|
---|
1273 | if UBAGlobals.EC <>'N' then
|
---|
1274 | if StrPos(PChar(strTFactors),PChar(ENVIRONMENTAL_CONTAM)) <> nil then
|
---|
1275 | UBAGlobals.EC := 'C';
|
---|
1276 |
|
---|
1277 | if UBAGlobals.MST <>'N' then
|
---|
1278 | if StrPos(PChar(strTFactors),PChar(MILITARY_SEXUAL_TRAUMA)) <> nil then
|
---|
1279 | UBAGlobals.MST := 'C';
|
---|
1280 |
|
---|
1281 | if UBAGlobals.CV <>'N' then
|
---|
1282 | if StrPos(PChar(strTFactors),PChar(COMBAT_VETERAN)) <> nil then
|
---|
1283 | UBAGlobals.CV := 'C';
|
---|
1284 |
|
---|
1285 | strFlagsOut := (UBAGlobals.SC + UBAGlobals.AO + UBAGlobals.IR +
|
---|
1286 | UBAGlobals.EC + UBAGlobals.MST + UBAGlobals.HNC +
|
---|
1287 | UBAGlobals.CV);
|
---|
1288 | Result := strFlagsOut;
|
---|
1289 | end;
|
---|
1290 |
|
---|
1291 | procedure GetBAStatus(pProvider:int64; pLocation:integer);
|
---|
1292 | begin
|
---|
1293 | // sets global switch, based in value returned from server.
|
---|
1294 | // True -> Billing Aware Switch ON. else OFF
|
---|
1295 |
|
---|
1296 | UBACore.rpcSetBillingAwareSwitch(pProvider,pLocation);
|
---|
1297 |
|
---|
1298 | if Assigned(UBAGlobals.BAPCEDiagList) then UBAGlobals.BAPCEDiagList.Clear;
|
---|
1299 | frmFrame.SetBADxList;
|
---|
1300 | if not UBAGlobals.BAFactorsRec.FBAFactorActive then
|
---|
1301 | UBACore.BuildTFHintRec;
|
---|
1302 | end;
|
---|
1303 |
|
---|
1304 | function IsICD9CodeActive(ACode: string; LexApp: string; ADate: TFMDateTime = 0): boolean;
|
---|
1305 | var
|
---|
1306 | inactiveChar : string;
|
---|
1307 | begin
|
---|
1308 | inactiveChar := '#';
|
---|
1309 | if StrPos(PChar(ACode),PChar(inactiveChar) ) <> nil then
|
---|
1310 | ACode := Piece(ACode,'#',1); // remove the '#' added for inactive code.
|
---|
1311 | Result := (sCallV('ORWPCE ACTIVE CODE',[ACode, LexApp, ADate]) = '1');
|
---|
1312 | end;
|
---|
1313 |
|
---|
1314 | function BuildConsultDxRec(ConsultRec: TBAConsultOrderRec): string;
|
---|
1315 | var
|
---|
1316 | newString: string;
|
---|
1317 | begin
|
---|
1318 | if strLen(PChar(ConsultRec.FBADxCode)) > 0 then
|
---|
1319 | newString := Piece(ConsultRec.FBADxCode,U,2)
|
---|
1320 | else
|
---|
1321 | if strLen(PChar(ConsultRec.FBASecDx1)) > 0 then
|
---|
1322 | newString := newString + '^' + Piece(ConsultRec.FBASecDx1,U,2)
|
---|
1323 | else
|
---|
1324 | if strLen(PChar(ConsultRec.FBASecDx2)) > 0 then
|
---|
1325 | newString := newString + '^' + Piece(ConsultRec.FBASecDx2,U,2)
|
---|
1326 | else
|
---|
1327 | if strLen(PChar(ConsultRec.FBASecDx3)) > 0 then
|
---|
1328 | newString := newString + '^' + Piece(ConsultRec.FBASecDx3,U,2);
|
---|
1329 | Result := newString;
|
---|
1330 | end;
|
---|
1331 |
|
---|
1332 | function ConvertPIMTreatmentFactors(pTFactors:string):string;
|
---|
1333 | var
|
---|
1334 | strSC,strAO, strIR: string;
|
---|
1335 | strEC, strMST, strHNC, strCV: string;
|
---|
1336 |
|
---|
1337 | begin
|
---|
1338 | Result := '';
|
---|
1339 | if StrPos(PChar(pTFactors),PChar(SERVICE_CONNECTED)) <> nil then
|
---|
1340 | strSC := '?'
|
---|
1341 | else
|
---|
1342 | strSC := 'N';
|
---|
1343 |
|
---|
1344 | if StrPos(PChar(pTFactors),PChar(AGENT_ORANGE)) <> nil then
|
---|
1345 | strAO := '?'
|
---|
1346 | else
|
---|
1347 | strAO := 'N';
|
---|
1348 |
|
---|
1349 | if StrPos(PChar(pTFactors),PChar(IONIZING_RADIATION)) <> nil then
|
---|
1350 | strIR := '?'
|
---|
1351 | else
|
---|
1352 | strIR := 'N';
|
---|
1353 |
|
---|
1354 | if StrPos(PChar(pTFactors),PChar(ENVIRONMENTAL_CONTAM)) <> nil then
|
---|
1355 | strEC := '?'
|
---|
1356 | else
|
---|
1357 | strEC := 'N';
|
---|
1358 |
|
---|
1359 | if StrPos(PChar(pTFactors),PChar(MILITARY_SEXUAL_TRAUMA)) <> nil then
|
---|
1360 | strMST := '?'
|
---|
1361 | else
|
---|
1362 | strMST := 'N';
|
---|
1363 |
|
---|
1364 | if StrPos(PChar(pTFactors),PChar(HEAD_NECK_CANCER)) <> nil then
|
---|
1365 | strHNC := '?'
|
---|
1366 | else
|
---|
1367 | strHNC := 'N';
|
---|
1368 |
|
---|
1369 | if StrPos(PChar(pTFactors),PChar(COMBAT_VETERAN)) <> nil then
|
---|
1370 | strCV := '?'
|
---|
1371 | else
|
---|
1372 | strCV := 'N';
|
---|
1373 |
|
---|
1374 | Result := (strSC + strAO + strIR + strEC + strMST + strHNC + strCV);
|
---|
1375 | end;
|
---|
1376 | // Delete dc'd orders from BACopiedOrderList to keep things in sync.
|
---|
1377 | procedure DeleteDCOrdersFromCopiedList(pOrderID:string);
|
---|
1378 | var i:integer;
|
---|
1379 | holdList: TStringList;
|
---|
1380 | x: string;
|
---|
1381 | begin
|
---|
1382 | holdList := TStringList.Create;
|
---|
1383 | holdList.Clear;
|
---|
1384 | holdList.Assign(UBAGlobals.BACopiedOrderFlags);
|
---|
1385 | UBAGlobals.BACopiedOrderFlags.Clear;
|
---|
1386 | for i := 0 to holdList.Count-1 do
|
---|
1387 | begin
|
---|
1388 | x := Piece(holdList.Strings[i],';',1);
|
---|
1389 | if pOrderID = Piece(holdList.Strings[i],';',1) then
|
---|
1390 | continue
|
---|
1391 | else
|
---|
1392 | UBAGlobals.BACopiedOrderFlags.Add(holdList.Strings[i]);
|
---|
1393 | end;
|
---|
1394 | end;
|
---|
1395 |
|
---|
1396 | procedure UpdateBAConsultOrderList(pDcOrders: TStringList);
|
---|
1397 | var
|
---|
1398 | AnOrder,x: string;
|
---|
1399 | var i,j: integer;
|
---|
1400 | holdList : TStringList;
|
---|
1401 | begin
|
---|
1402 | // remove order enteries from the dx list that are being discontinued.
|
---|
1403 | for i := 0 to pDcOrders.Count -1 do
|
---|
1404 | begin
|
---|
1405 | UBAGlobals.RemoveOrderFromDxList(pDcOrders.Strings[i]);
|
---|
1406 | end;
|
---|
1407 | if UBAGlobals.BAConsultPLFlags.Count > 0 then
|
---|
1408 | begin
|
---|
1409 | holdList := TStringList.Create;
|
---|
1410 | holdList.Clear;
|
---|
1411 | holdList.Assign(UBAGlobals.BAConsultPLFlags);
|
---|
1412 | UBAGlobals.BAConsultPLFlags.Clear;
|
---|
1413 | for i := 0 to holdList.Count-1 do
|
---|
1414 | begin
|
---|
1415 | x := holdList.Strings[i];
|
---|
1416 | for j := 0 to pDcOrders.Count-1 do
|
---|
1417 | begin
|
---|
1418 | if x = pDcOrders.Strings[j] then
|
---|
1419 | continue
|
---|
1420 | else
|
---|
1421 | UBAGlobals.BAConsultPLFlags.Add(x);
|
---|
1422 | end;
|
---|
1423 | end;
|
---|
1424 | end;
|
---|
1425 | end;
|
---|
1426 |
|
---|
1427 | {function SetOrderIDConsultDxRequired(pOrderID:string):string;
|
---|
1428 | var
|
---|
1429 | i: integer;
|
---|
1430 | orderIdIN, OrderIdOut,x: string;
|
---|
1431 | begin
|
---|
1432 | result := '';
|
---|
1433 | for i := 0 to UBAGlobals.BAConsultOrdersRequireDx.Count-1 do
|
---|
1434 | begin
|
---|
1435 | orderIdIN := pOrderID;
|
---|
1436 | x := UBAGlobals.BAConsultOrdersRequireDx.Strings[i];
|
---|
1437 | if orderIdIN = UBAGlobals.BAConsultOrdersRequireDx.Strings[i] then
|
---|
1438 | orderIdOUT := 'CONSULT_DX' // consult requires dx entry. enable display of cidc and non-cidc
|
---|
1439 | else
|
---|
1440 | orderIdOUT := orderIdIN;
|
---|
1441 | end;
|
---|
1442 | result := OrderIdOut;
|
---|
1443 | end;
|
---|
1444 | }
|
---|
1445 |
|
---|
1446 | end.
|
---|
1447 |
|
---|
1448 |
|
---|
1449 |
|
---|