source: cprs/branches/tmg-cprs/CPRS-Chart/Encounter/uPCE.pas@ 1802

Last change on this file since 1802 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69

File size: 119.4 KB
RevLine 
[453]1//kt -- Modified with SourceScanner on 8/8/2007
2unit uPCE;
3
4interface
5
6uses Windows, SysUtils, Classes, ORFn, uConst, ORCtrls, ORClasses,UBAGlobals;
7
8type
9 TPCEProviderRec = record
10 IEN: int64;
11 Name: string;
12 Primary: boolean;
13 Delete: boolean;
14 end;
15
16 TPCEProviderList = class(TORStringList)
17 private
18 FNoUpdate: boolean;
19 FOnPrimaryChanged: TNotifyEvent;
20 FPendingDefault: string;
21 FPendingUser: string;
22 FPCEProviderIEN: Int64;
23 FPCEProviderName: string;
24 function GetProviderData(Index: integer): TPCEProviderRec;
25 procedure SetProviderData(Index: integer; const Value: TPCEProviderRec);
26 function GetPrimaryIdx: integer;
27 procedure SetPrimaryIdx(const Value: integer);
28 procedure SetPrimary(index: integer; Primary: boolean);
29 public
30 function Add(const S: string): Integer; override;
31 function AddProvider(AIEN, AName: string; APrimary: boolean): integer;
32 procedure Assign(Source: TPersistent); override;
33 function PCEProvider: Int64;
34 function PCEProviderName: string;
35 function IndexOfProvider(AIEN: string): integer;
36 procedure Merge(AList: TPCEProviderList);
37 procedure Clear; override;
38 procedure Delete(Index: Integer); override;
39 function PrimaryIEN: int64;
40 function PrimaryName: string;
41 function PendingIEN(ADefault: boolean): Int64;
42 function PendingName(ADefault: boolean): string;
43 property ProviderData[Index: integer]: TPCEProviderRec read GetProviderData
44 write SetProviderData; default;
45 property PrimaryIdx: integer read GetPrimaryIdx write SetPrimaryIdx;
46 property OnPrimaryChanged: TNotifyEvent read FOnPrimaryChanged
47 write FOnPrimaryChanged;
48 end;
49
50 TPCEItem = class(TObject)
51 {base class for PCE items}
52 private
53 FDelete: Boolean; //flag for deletion
54 FSend: Boolean; //flag to send to broker
55 FComment: String;
56 protected
57 procedure SetComment(const Value: String);
58 public
59// Provider: Int64;
60 Provider: Int64;
61 Code: string;
62 Category: string;
63 Narrative: string;
64 FGecRem: string;
65 procedure Assign(Src: TPCEItem); virtual;
66 procedure Clear; virtual;
67 function DelimitedStr: string; virtual;
68 function DelimitedStr2: string; virtual;
69 function ItemStr: string; virtual;
70 function Match(AnItem: TPCEItem): Boolean;
71// function MatchProvider(AnItem: TPCEItem):Boolean;
72 function MatchProvider(AnItem: TPCEItem):Boolean;
73 procedure SetFromString(const x: string); virtual;
74 function HasCPTStr: string; virtual;
75 property Comment: String read FComment write SetComment;
76 property GecRem: string read FGecRem write FGecRem;
77 end;
78
79 TPCEItemClass = class of TPCEItem;
80
81 TPCEProc = class(TPCEItem)
82 {class for procedures}
83 public
84 FIsOldProcedure: boolean;
85 Quantity: Integer;
86 Modifiers: string; // Format Modifier1IEN;Modifier2IEN;Modifier3IEN; Trailing ; needed
87// Provider: Int64; {jm 9/8/99}
88 Provider: Int64; {jm 9/8/99}
89 procedure Assign(Src: TPCEItem); override;
90 procedure Clear; override;
91 function DelimitedStr: string; override;
92// function DelimitedStrC: string;
93// function Match(AnItem: TPCEProc): Boolean;
94 function ModText: string;
95 function ItemStr: string; override;
96 procedure SetFromString(const x: string); override;
97 procedure CopyProc(Dest: TPCEProc);
98 function Empty: boolean;
99 end;
100
101 TPCEDiag = class(TPCEItem)
102 {class for diagnosis}
103 public
104 fProvider: Int64;
105 Primary: Boolean;
106 AddProb: Boolean;
107 OldComment: string;
108 SaveComment: boolean;
109 procedure Assign(Src: TPCEItem); override;
110 procedure Clear; override;
111 function DelimitedStr: string; override;
112 function DelimitedStr2: string; override;
113// function delimitedStrC: string;
114 function ItemStr: string; override;
115 procedure SetFromString(const x: string); override;
116 procedure Send;
117 end;
118
119 TPCEExams = class(TPCEItem)
120 {class for Examinations}
121 public
122// Provider: Int64;
123 Results: String;
124 procedure Assign(Src: TPCEItem); override;
125 procedure Clear; override;
126 function DelimitedStr: string; override;
127// function delimitedStrC: string;
128 function ItemStr: string; override;
129 procedure SetFromString(const x: string); override;
130 function HasCPTStr: string; override;
131 end;
132
133
134 TPCEHealth = class(TPCEItem)
135 {class for Health Factors}
136 public
137// Provider: Int64; {jm 9/8/99}
138 Level: string;
139 procedure Assign(Src: TPCEItem); override;
140 procedure Clear; override;
141 function DelimitedStr: string; override;
142// function delimitedStrC: string;
143 function ItemStr: string; override;
144 procedure SetFromString(const x: string); override;
145 function HasCPTStr: string; override;
146 end;
147
148 TPCEImm = class(TPCEItem)
149 {class for immunizations}
150 public
151// Provider: Int64; {jm 9/8/99}
152 Series: String;
153 Reaction: String;
154 Refused: Boolean; //not currently used
155 Contraindicated: Boolean;
156 procedure Assign(Src: TPCEItem); override;
157 procedure Clear; override;
158 function DelimitedStr: string; override;
159// function delimitedStrC: string;
160 function ItemStr: string; override;
161 procedure SetFromString(const x: string); override;
162 function HasCPTStr: string; override;
163 end;
164
165 TPCEPat = class(TPCEItem)
166 {class for patient Education}
167 public
168// Provider: Int64; {jm 9/8/99}
169 Level: String;
170 procedure Assign(Src: TPCEItem); override;
171 procedure Clear; override;
172 function DelimitedStr: string; override;
173// function delimitedStrC: string;
174 function ItemStr: string; override;
175 procedure SetFromString(const x: string); override;
176 function HasCPTStr: string; override;
177 end;
178
179 TPCESkin = class(TPCEItem)
180 {class for skin tests}
181 public
182// Provider: Int64; {jm 9/8/99}
183 Results: String; //Do not confuse for reserved word "result"
184 Reading: Integer;
185 DTRead: TFMDateTime;
186 DTGiven: TFMDateTime;
187 procedure Assign(Src: TPCEItem); override;
188 procedure Clear; override;
189 function DelimitedStr: string; override;
190// function delimitedStrC: string;
191 function ItemStr: string; override;
192 procedure SetFromString(const x: string); override;
193 function HasCPTStr: string; override;
194 end;
195
196// TPCEData = class;
197
198 tRequiredPCEDataType = (ndDiag, ndProc, ndSC); {jm 9/9/99}
199 tRequiredPCEDataTypes = set of tRequiredPCEDataType;
200
201 //modified: 6/9/99
202 //By: Robert Bott
203 //Location: ISL
204 //Purpose: Changed to allow capture of multiple providers.
205 TPCEData = class
206 {class for data to be passed to and from broker}
207 private
208 FUpdated: boolean;
209 FEncDateTime: TFMDateTime; //encounter date & time
210 FNoteDateTime: TFMDateTime; //Note date & time
211 FEncLocation: Integer; //encounter location
212 FEncSvcCat: Char; //
213 FEncInpatient: Boolean; //Inpatient flag
214 FEncUseCurr: Boolean; //
215 FSCChanged: Boolean; //
216 FSCRelated: Integer; //service con. related?
217 FAORelated: Integer; //
218 FIRRelated: Integer; //
219 FECRelated: Integer; //
220 FMSTRelated: Integer; //
221 FHNCRelated: Integer; //
222 FCVRelated: Integer; //
223 FVisitType: TPCEProc; //
224 FProviders: TPCEProviderList;
225 FDiagnoses: TList; //pointer list for diagnosis
226 FProcedures: TList; //pointer list for Procedures
227 FImmunizations: TList; //pointer list for Immunizations
228 FSkinTests: TList; //pointer list for skin tests
229 FPatientEds: TList;
230 FHealthFactors: TList;
231 fExams: TList;
232 FNoteTitle: Integer;
233 FNoteIEN: Integer;
234 FParent: string; // Parent Visit for secondary encounters
235 FHistoricalLocation: string; // Institution IEN^Name (if IEN=0 Piece 4 = outside location)
236 FStandAlone: boolean;
237 FStandAloneLoaded: boolean;
238
239 function GetVisitString: string;
240 function GetCPTRequired: Boolean;
241 function getDocCount: Integer;
242 function MatchItem(AList: TList; AnItem: TPCEItem): Integer;
243 procedure MarkDeletions(PreList: TList; PostList: TStrings);
244 procedure SetSCRelated(Value: Integer);
245 procedure SetAORelated(Value: Integer);
246 procedure SetIRRelated(Value: Integer);
247 procedure SetECRelated(Value: Integer);
248 procedure SetMSTRelated(Value: Integer);
249 procedure SetHNCRelated(Value: Integer);
250 procedure SetCVRelated(Value: Integer);
251 procedure SetEncUseCurr(Value: Boolean);
252 function GetHasData: Boolean;
253 procedure GetHasCPTList(AList: TStrings);
254 procedure CopyPCEItems(Src: TList; Dest: TObject; ItemClass: TPCEItemClass);
255 public
256 constructor Create;
257 destructor Destroy; override;
258 procedure Clear;
259 procedure CopyPCEData(Dest: TPCEData);
260 function Empty: boolean;
261 procedure PCEForNote(NoteIEN: Integer; EditObj: TPCEData);(* overload;
262 procedure PCEForNote(NoteIEN: Integer; EditObj: TPCEData; DCSummAdmitString: string); overload;*)
263 procedure Save;
264 procedure CopyDiagnoses(Dest: TStrings); // ICDcode^P|S^Category^Narrative^P|S Text
265 procedure CopyProcedures(Dest: TStrings); // CPTcode^Qty^Category^Narrative^Qty Text
266 procedure CopyImmunizations(Dest: TStrings); //
267 procedure CopySkinTests(Dest: TStrings); //
268 procedure CopyPatientEds(Dest: TStrings);
269 procedure CopyHealthFactors(Dest: TStrings);
270 procedure CopyExams(Dest: TStrings);
271
272 procedure SetDiagnoses(Src: TStrings; FromForm: boolean = TRUE); // ICDcode^P|S^Category^Narrative^P|S Text
273 procedure SetExams(Src: TStrings; FromForm: boolean = TRUE);
274 Procedure SetHealthFactors(Src: TStrings; FromForm: boolean = TRUE);
275 procedure SetImmunizations(Src: TStrings; FromForm: boolean = TRUE); // IMMcode^
276 Procedure SetPatientEds(Src: TStrings; FromForm: boolean = TRUE);
277 procedure SetSkinTests(Src: TStrings; FromForm: boolean = TRUE); //
278 procedure SetProcedures(Src: TStrings; FromForm: boolean = TRUE); // CPTcode^Qty^Category^Narrative^Qty Text
279
280 procedure SetVisitType(Value: TPCEProc); // CPTcode^1^Category^Narrative
281 function StrDiagnoses: string; // Diagnoses: ...
282 function StrImmunizations: string; // Immunizzations: ...
283 function StrProcedures: string; // Procedures: ...
284 function StrSkinTests: string;
285 function StrPatientEds: string;
286 function StrHealthFactors: string;
287 function StrExams: string;
288 function StrVisitType(const ASCRelated, AAORelated, AIRRelated, AECRelated,
289 AMSTRelated, AHNCRelated, ACVRelated: Integer): string; overload;
290 function StrVisitType: string; overload;
291 function StandAlone: boolean;
292 procedure AddStrData(List: TStrings);
293 procedure AddVitalData(Data, List: TStrings);
294
295 function NeededPCEData: tRequiredPCEDataTypes;
296 function OK2SignNote: boolean;
297
298 function PersonClassDate: TFMDateTime;
299 function VisitDateTime: TFMDateTime;
300 function IsSecondaryVisit: boolean;
301 function NeedProviderInfo: boolean;
302
303 property HasData: Boolean read GetHasData;
304 property CPTRequired: Boolean read GetCPTRequired;
305 property Inpatient: Boolean read FEncInpatient;
306 property UseEncounter: Boolean read FEncUseCurr write SetEncUseCurr;
307 property SCRelated: Integer read FSCRelated write SetSCRelated;
308 property AORelated: Integer read FAORelated write SetAORelated;
309 property IRRelated: Integer read FIRRelated write SetIRRelated;
310 property ECRelated: Integer read FECRelated write SetECRelated;
311 property MSTRelated: Integer read FMSTRelated write SetMSTRelated;
312 property HNCRelated: Integer read FHNCRelated write SetHNCRelated;
313 property CVRelated: Integer read FCVRelated write SetCVRelated;
314 property VisitType: TPCEProc read FVisitType write SetVisitType;
315 property VisitString: string read GetVisitString;
316 property VisitCategory:char read FEncSvcCat write FEncSvcCat;
317 property DateTime: TFMDateTime read FEncDateTime write FEncDateTime;
318 property NoteDateTime: TFMDateTime read FNoteDateTime write FNoteDateTime;
319 property Location: Integer Read FencLocation;
320 property NoteTitle: Integer read FNoteTitle write FNoteTitle;
321 property NoteIEN: Integer read FNoteIEN write FNoteIEN;
322 property DocCOunt: Integer read GetDocCount;
323 property Providers: TPCEProviderList read FProviders;
324 property Parent: string read FParent write FParent;
325 property HistoricalLocation: string read FHistoricalLocation write FHistoricalLocation;
326 property Updated: boolean read FUpdated write FUpdated;
327 end;
328
329type
330 TPCEType = (ptEncounter, ptReminder, ptTemplate);
331
332//kt const
333//kt PCETypeText: array[TPCEType] of string = ('encounter', 'reminder', 'template');
334function PCETypeText (index : TPCEType) : string; //kt 8/15/07
335
336function InvalidPCEProviderTxt(AIEN: Int64; ADate: TFMDateTime): string;
337function MissingProviderInfo(PCEEdit: TPCEData; PCEType: TPCEType = ptEncounter): boolean;
338function IsOK2Sign(const PCEData: TPCEData; const IEN: integer) :boolean;
339function FutureEncounter(APCEData: TPCEData): boolean;
340function CanEditPCE(APCEData: TPCEData): boolean;
341procedure GetPCECodes(List: TStrings; CodeType: integer);
342procedure GetComboBoxMinMax(dest: TORComboBox; var Min, Max: integer);
343procedure PCELoadORCombo(dest: TORComboBox); overload;
344procedure PCELoadORCombo(dest: TORComboBox; var Min, Max: integer); overload;
345function GetPCEDisplayText(ID: string; Tag: integer): string;
346procedure SetDefaultProvider(ProviderList: TPCEProviderList; APCEData: TPCEData);
347function ValidateGAFDate(var GafDate: TFMDateTime): string;
348procedure GetVitalsFromDate(VitalStr: TStrings; PCEObj: TPCEData);
349procedure GetVitalsFromNote(VitalStr: TStrings; PCEObj: TPCEData; ANoteIEN: Int64);
350
351type
352 TPCEDataCat = (pdcVisit, pdcDiag, pdcProc, pdcImm, pdcSkin, pdcPED, pdcHF,
353 pdcExam, pdcVital, pdcOrder, pdcMH, pdcMST, pdcHNC, pdcWHR, pdcWH);
354
355function GetPCEDataText(Cat: TPCEDataCat; Code, Category, Narrative: string;
356 PrimaryDiag: boolean = FALSE; Qty: integer = 0): string;
357
358function PCEDataCatText (index: TPCEDataCat) : string; //kt 8/15/07 -- replace const with Fn
359(*const
360 PCEDataCatText: array[TPCEDataCat] of string =
361 { dcVisit } ('',
362 { dcDiag } 'Diagnoses: ',
363 { dcProc } 'Procedures: ',
364 { dcImm } 'Immunizations: ',
365 { dcSkin } 'Skin Tests: ',
366 { dcPED } 'Patient Educations: ',
367 { dcHF } 'Health Factors: ',
368 { dcExam } 'Examinations: ',
369 { dcVital } '',
370 { dcOrder } 'Orders: ',
371 { dcMH } 'Mental Health: ',
372 { dcMST } 'MST History: ',
373 { dcHNC } 'Head and/or Neck Cancer: ',
374 { dcWHR } 'Women''s Health Procedure: ',
375 { dcWH } 'WH Notification: ');
376*)
377
378const
379 NoPCEValue = '@';
380 TAB_STOP_CHARS = 7;
381(*TX_NO_VISIT = 'Insufficient Visit Information';
382 TX_NEED_PROV1 = 'The provider responsible for this encounter must be entered before ';
383 TX_NEED_PROV2 = ' information may be entered.';
384 TX_NEED_PROV3 = 'you can sign the note.';
385 TX_NO_PROV = 'Missing Provider';
386 TX_BAD_PROV = 'Invalid Provider';
387 TX_NOT_ACTIVE = ' does not have an active person class.';
388 TX_NOT_PROV = ' is not a known Provider.';
389 TX_MISSING = 'Required Information Missing';
390 TX_REQ1 = 'The following required fields have not been entered:' + CRLF;
391 TC_REQ = 'Required Fields';
392 TX_ADDEND_AD = 'Cannot make an addendum to an addendum' + CRLF +
393 'Please select the parent note or document, and try again.'; <-- original line. //kt 8/8/2007
394 TX_ADDEND_MK = 'Unable to Make Addendum';
395 TX_DEL_CNF = 'Confirm Deletion';
396 TX_IN_AUTH = 'Insufficient Authorization';
397 TX_NOPCE = '<No encounter information entered>';
398 TX_NEED_T = 'Missing Encounter Information';
399 TX_NEED1 = 'This note title is marked to prompt for the following missing' + CRLF +
400 'encounter information:' + CRLF; <-- original line. //kt 8/8/2007
401 TX_NEED_DIAG = ' A diagnosis.';
402 TX_NEED_PROC = ' A visit type or procedure.';
403 TX_NEED_SC = ' One or more service connected questions.';
404 TX_NEED2 = 'Would you like to enter encounter information now?';
405 TX_NEED3 = 'You must enter the encounter information before you can sign the note.';
406 TX_NEEDABORT = 'Document not signed.';
407 TX_COS_REQ = 'A cosigner is required for this document.';
408 TX_COS_SELF = 'You cannot make yourself a cosigner.';
409 TX_COS_AUTH = ' is not authorized to cosign this document.';
410 TC_COS = 'Select Cosigner';
411*)
412
413function TX_NO_VISIT : string; //kt 8-25-07 replace const with Fn.
414function TX_NEED_PROV1: string; //kt 8-25-07 replace const with Fn.
415function TX_NEED_PROV2: string; //kt 8-25-07 replace const with Fn.
416function TX_NEED_PROV3: string; //kt 8-25-07 replace const with Fn.
417function TX_NO_PROV : string; //kt 8-25-07 replace const with Fn.
418function TX_BAD_PROV : string; //kt 8-25-07 replace const with Fn.
419function TX_NOT_ACTIVE: string; //kt 8-25-07 replace const with Fn.
420function TX_NOT_PROV : string; //kt 8-25-07 replace const with Fn.
421function TX_MISSING : string; //kt 8-25-07 replace const with Fn.
422function TX_REQ1 : string; //kt 8-25-07 replace const with Fn.
423function TC_REQ : string; //kt 8-25-07 replace const with Fn.
424function TX_ADDEND_AD : string; //kt 8-25-07 replace const with Fn.
425function TX_ADDEND_MK : string; //kt 8-25-07 replace const with Fn.
426function TX_DEL_CNF : string; //kt 8-25-07 replace const with Fn.
427function TX_IN_AUTH : string; //kt 8-25-07 replace const with Fn.
428function TX_NOPCE : string; //kt 8-25-07 replace const with Fn.
429function TX_NEED_T : string; //kt 8-25-07 replace const with Fn.
430function TX_NEED1 : string; //kt 8-25-07 replace const with Fn.
431function TX_NEED_DIAG : string; //kt 8-25-07 replace const with Fn.
432function TX_NEED_PROC : string; //kt 8-25-07 replace const with Fn.
433function TX_NEED_SC : string; //kt 8-25-07 replace const with Fn.
434function TX_NEED2 : string; //kt 8-25-07 replace const with Fn.
435function TX_NEED3 : string; //kt 8-25-07 replace const with Fn.
436function TX_NEEDABORT : string; //kt 8-25-07 replace const with Fn.
437function TX_COS_REQ : string; //kt 8-25-07 replace const with Fn.
438function TX_COS_SELF : string; //kt 8-25-07 replace const with Fn.
439function TX_COS_AUTH : string; //kt 8-25-07 replace const with Fn.
440function TC_COS : string; //kt 8-25-07 replace const with Fn.
441
442const
443 TAG_IMMSERIES = 10;
444 TAG_IMMREACTION= 20;
445 TAG_SKRESULTS = 30;
446 TAG_PEDLEVEL = 40;
447 TAG_HFLEVEL = 50;
448 TAG_XAMRESULTS = 60;
449 TAG_HISTLOC = 70;
450
451{ These piece numbers are used by both the PCE objects and reminders }
452 pnumCode = 2;
453 pnumPrvdrIEN = 2;
454 pnumCategory = 3;
455 pnumNarrative = 4;
456 pnumExamResults = 5;
457 pnumSkinResults = 5;
458 pnumHFLevel = 5;
459 pnumImmSeries = 5;
460 pnumProcQty = 5;
461 pnumPEDLevel = 5;
462 pnumDiagPrimary = 5;
463 pnumPrvdrName = 5;
464 pnumProvider = 6;
465 pnumPrvdrPrimary = 6;
466 pnumSkinReading = 7;
467 pnumImmReaction = 7;
468 pnumDiagAdd2PL = 7;
469 pnumSkinDTRead = 8;
470 pnumImmContra = 8;
471 pnumSkinDTGiven = 9;
472 pnumImmRefused = 9;
473 pnumCPTMods = 9;
474 pnumComment = 10;
475 pnumWHPapResult =11;
476 pnumWHNotPurp =12;
477
478 USE_CURRENT_VISITSTR = -2;
479
480implementation
481
482uses uCore, rPCE, rCore, rTIU, fEncounterFrame, uVitals, fFrame,
483 fPCEProvider, rVitals, uReminders
484 ,DKLang //kt
485 ;
486
487const
488 FN_NEW_PERSON = 200;
489
490//kt PCETypeText: array[TPCEType] of string = ('encounter', 'reminder', 'template');
491function PCETypeText (index : TPCEType) : string; //kt 8/15/07
492begin
493 Result := '';
494 Case index of
495 ptEncounter : Result := 'encounter';
496 ptReminder : Result := 'reminder';
497 ptTemplate : Result := 'template'
498 end; {case}
499end;
500
501
502function PCEDataCatText (index : TPCEDataCat): string;
503begin
504 Result := '';
505 case index of
506 pdcVisit : Result := '';
507 pdcDiag : Result := DKLangConstW('uPCE_Diagnosesx');
508 pdcProc : Result := DKLangConstW('uPCE_Proceduresx');
509 pdcImm : Result := DKLangConstW('uPCE_Immunizationsx');
510 pdcSkin : Result := DKLangConstW('uPCE_Skin_Testsx');
511 pdcPED : Result := DKLangConstW('uPCE_Patient_Educationsx');
512 pdcHF : Result := DKLangConstW('uPCE_Health_Factorsx');
513 pdcExam : Result := DKLangConstW('uPCE_Examinationsx');
514 pdcVital : Result := '';
515 pdcOrder : Result := DKLangConstW('uPCE_Ordersx');
516 pdcMH : Result := DKLangConstW('uPCE_Mental_Healthx');
517 pdcMST : Result := DKLangConstW('uPCE_MST_Historyx');
518 pdcHNC : Result := DKLangConstW('uPCE_Head_andxor_Neck_Cancerx');
519 pdcWHR : Result := DKLangConstW('uPCE_Womenxxs_Health_Procedurex');
520 pdcWH : Result := DKLangConstW('uPCE_WH_Notificationx');
521 end; {case}
522end;
523
524//kt 8-15-07 Begin mod. Converting constants into functions
525function TX_NO_VISIT: string; begin Result := DKLangConstW('uPCE_Insufficient_Visit_Information'); end; //kt added 8/8/2007
526function TX_NEED_PROV1: string; begin Result := DKLangConstW('uPCE_The_provider_responsible_for_this_encounter_must_be_entered_before'); end;
527function TX_NEED_PROV2: string; begin Result := DKLangConstW('uPCE_information_may_be_enteredx'); end;
528function TX_NEED_PROV3: string; begin Result := DKLangConstW('uPCE_you_can_sign_the_notex'); end;
529function TX_NO_PROV : string; begin Result := DKLangConstW('uPCE_Missing_Provider'); end;
530function TX_BAD_PROV : string; begin Result := DKLangConstW('uPCE_Invalid_Provider'); end;
531function TX_NOT_ACTIVE: string; begin Result := DKLangConstW('uPCE_does_not_have_an_active_person_classx'); end;
532function TX_NOT_PROV : string; begin Result := DKLangConstW('uPCE_is_not_a_known_Providerx'); end;
533function TX_MISSING : string; begin Result := DKLangConstW('uPCE_Required_Information_Missing'); end;
534function TX_REQ1 : string; begin Result := DKLangConstW('uPCE_The_following_required_fields_have_not_been_enteredx') + CRLF; end;
535function TC_REQ : string; begin Result := DKLangConstW('uPCE_Required_Fields'); end;
536function TX_ADDEND_AD : string;
537begin
538 Result := DKLangConstW('uPCE_Cannot_make_an_addendum_to_an_addendum') + CRLF +
539 DKLangConstW('uPCE_Please_select_the_parent_note_or_documentx_and_try_againx');
540end;
541function TX_ADDEND_MK : string; begin Result := DKLangConstW('uPCE_Unable_to_Make_Addendum'); end;
542function TX_DEL_CNF : string; begin Result := DKLangConstW('uPCE_Confirm_Deletion'); end;
543function TX_IN_AUTH : string; begin Result := DKLangConstW('uPCE_Insufficient_Authorization'); end;
544function TX_NOPCE : string; begin Result := DKLangConstW('uPCE_xNo_encounter_information_enteredx'); end;
545function TX_NEED_T : string; begin Result := DKLangConstW('uPCE_Missing_Encounter_Information'); end;
546function TX_NEED1 : string;
547begin
548 Result := DKLangConstW('uPCE_This_note_title_is_marked_to_prompt_for_the_following_missing') + CRLF +
549 DKLangConstW('uPCE_encounter_informationx') + CRLF;
550end;
551function TX_NEED_DIAG : string; begin Result := DKLangConstW('uPCE_A_diagnosisx'); end;
552function TX_NEED_PROC : string; begin Result := DKLangConstW('uPCE_A_visit_type_or_procedurex'); end;
553function TX_NEED_SC : string; begin Result := DKLangConstW('uPCE_One_or_more_service_connected_questionsx'); end;
554function TX_NEED2 : string; begin Result := DKLangConstW('uPCE_Would_you_like_to_enter_encounter_information_nowx'); end;
555function TX_NEED3 : string; begin Result := DKLangConstW('uPCE_You_must_enter_the_encounter_information_before_you_can_sign_the_notex'); end;
556function TX_NEEDABORT : string; begin Result := DKLangConstW('uPCE_Document_not_signedx'); end;
557function TX_COS_REQ : string; begin Result := DKLangConstW('uPCE_A_cosigner_is_required_for_this_documentx'); end;
558function TX_COS_SELF : string; begin Result := DKLangConstW('uPCE_You_cannot_make_yourself_a_cosignerx'); end;
559function TX_COS_AUTH : string; begin Result := DKLangConstW('uPCE_is_not_authorized_to_cosign_this_documentx'); end;
560function TC_COS : string; begin Result := DKLangConstW('uPCE_Select_Cosigner'); end;
561
562
563function InvalidPCEProviderTxt(AIEN: Int64; ADate: TFMDateTime): string;
564begin
565 Result := '';
566 if(not CheckActivePerson(IntToStr(AIEN), ADate)) then
567 Result := TX_NOT_ACTIVE
568 else
569 if(not IsUserAProvider(AIEN, ADate)) then
570 Result := TX_NOT_PROV;
571end;
572
573function MissingProviderInfo(PCEEdit: TPCEData; PCEType: TPCEType = ptEncounter): boolean;
574begin
575 if(PCEEdit.Empty and (PCEEdit.Location <> Encounter.Location) and (not Encounter.NeedVisit)) then
576 PCEEdit.UseEncounter := TRUE;
577 Result := NoPrimaryPCEProvider(PCEEdit.Providers, PCEEdit);
578 if(Result) then
579 //kt InfoBox(TX_NEED_PROV1 + PCETypeText[PCEType] + TX_NEED_PROV2, TX_NO_PROV, MB_OK or MB_ICONWARNING);
580 InfoBox(TX_NEED_PROV1 + PCETypeText(PCEType) + TX_NEED_PROV2, TX_NO_PROV, MB_OK or MB_ICONWARNING);
581end;
582
583var
584 UNxtCommSeqNum: integer;
585
586function IsOK2Sign(const PCEData: TPCEData; const IEN: integer) :boolean;
587var
588 TmpPCEData: TPCEData;
589
590begin
591 if(assigned(PCEData)) then
592 PCEData.FUpdated := FALSE;
593 if(assigned(PCEData) and (PCEData.VisitString <> '') and
594 (VisitStrForNote(IEN) = PCEData.VisitString)) then
595 begin
596 if(PCEData.FNoteIEN <= 0) then
597 PCEData.FNoteIEN := IEN;
598 Result := PCEData.OK2SignNote
599 end
600 else
601 begin
602 TmpPCEData := TPCEData.Create;
603 try
604 TmpPCEData.PCEForNote(IEN, nil);
605 Result := TmpPCEData.OK2SignNote;
606 finally
607 TmpPCEData.Free;
608 end;
609 end;
610end;
611
612function FutureEncounter(APCEData: TPCEData): boolean;
613begin
614 Result := (Int(APCEData.FEncDateTime + 0.0000001) > Int(FMToday + 0.0000001));
615end;
616
617function CanEditPCE(APCEData: TPCEData): boolean;
618begin
619 if(GetAskPCE(APCEData.FEncLocation) = apDisable) then
620 Result := FALSE
621 else
622 Result := (not FutureEncounter(APCEData));
623end;
624
625procedure GetComboBoxMinMax(dest: TORComboBox; var Min, Max: integer);
626var
627 DC: HDC;
628 SaveFont: HFont;
629 TextSize: TSize;
630 TLen, i: integer;
631 x: string;
632
633begin
634 Min := MaxInt;
635 Max := 0;
636 DC := GetDC(0);
637 try
638 SaveFont := SelectObject(DC, dest.Font.Handle);
639 try
640 for i := 0 to dest.Items.Count-1 do
641 begin
642 x := dest.DisplayText[i];
643 GetTextExtentPoint32(DC, PChar(x), Length(x), TextSize);
644 TLen := TextSize.cx;
645 if(TLen > 0) and (Min > TLen) then
646 Min := TLen;
647 if(Max < TLen) then
648 Max := TLen;
649 end;
650 finally
651 SelectObject(DC, SaveFont);
652 end;
653 finally
654 ReleaseDC(0, DC);
655 end;
656 if(Min > Max) then Min := Max;
657
658 inc(Min, ScrollBarWidth + 8);
659 inc(Max, ScrollBarWidth + 8);
660end;
661
662type
663 TListMinMax = (mmMin, mmMax, mmFont);
664
665var
666 PCESetsOfCodes: TStringList = nil;
667 HistLocations: TORStringList = nil;
668 WHNotPurpose: TORStringList = nil;
669 WHPapResult: TORStringList = nil;
670 WHMammResult: TORStringList = nil;
671 WHUltraResult: TORStringList = nil;
672const
673 SetOfCodesHeader = '{^~Codes~^}';
674 SOCHeaderLen = length(SetOfCodesHeader);
675 ListMinMax: array[1..7, TListMinMax] of integer =
676 ((0,0,-1), // TAG_IMMSERIES
677 (0,0,-1), // TAG_IMMREACTION
678 (0,0,-1), // TAG_SKRESULTS
679 (0,0,-1), // TAG_PEDLEVEL
680 (0,0,-1), // TAG_HFLEVEL
681 (0,0,-1), // TAG_XAMRESULTS
682 (0,0,-1)); // TAG_HISTLOC
683
684function CodeSetIndex(CodeType: integer): integer;
685var
686 TempSL: TStringList;
687 Hdr: string;
688
689begin
690 Hdr := SetOfCodesHeader + IntToStr(CodeType);
691 Result := PCESetsOfCodes.IndexOf(Hdr);
692 if(Result < 0) then
693 begin
694 TempSL := TStringList.Create;
695 try
696 case CodeType of
697 TAG_IMMSERIES: LoadImmSeriesItems(TempSL);
698 TAG_IMMREACTION: LoadImmReactionItems(TempSL);
699 TAG_SKRESULTS: LoadSkResultsItems(TempSL);
700 TAG_PEDLEVEL: LoadPEDLevelItems(TempSL);
701 TAG_HFLEVEL: LoadHFLevelItems(TempSL);
702 TAG_XAMRESULTS: LoadXAMResultsItems(TempSL);
703 else
704 KillObj(@TempSL);
705 end;
706 if(assigned(TempSL)) then
707 begin
708 Result := PCESetsOfCodes.Add(Hdr);
709 PCESetsOfCodes.AddStrings(TempSL);
710 end;
711 finally
712 KillObj(@TempSL);
713 end;
714 end;
715end;
716
717procedure GetPCECodes(List: TStrings; CodeType: integer);
718var
719 idx: integer;
720
721 begin
722 if(CodeType = TAG_HISTLOC) then
723 begin
724 if(not assigned(HistLocations)) then
725 begin
726 HistLocations := TORStringList.Create;
727 LoadHistLocations(HistLocations);
728 HistLocations.SortByPiece(2);
729 HistLocations.Insert(0,'0');
730 end;
731 List.AddStrings(HistLocations);
732 end
733 else
734 begin
735 if(not assigned(PCESetsOfCodes)) then
736 PCESetsOfCodes := TStringList.Create;
737 idx := CodeSetIndex(CodeType);
738 if(idx >= 0) then
739 begin
740 inc(idx);
741 while((idx < PCESetsOfCodes.Count) and
742 (copy(PCESetsOfCodes[idx],1,SOCHeaderLen) <> SetOfCodesHeader)) do
743 begin
744 List.Add(PCESetsOfCodes[idx]);
745 inc(idx);
746 end;
747 end;
748 end;
749end;
750
751function GetPCECodeString(CodeType: integer; ID: string): string;
752var
753 idx: integer;
754
755begin
756 Result := '';
757 if(CodeType <> TAG_HISTLOC) then
758 begin
759 if(not assigned(PCESetsOfCodes)) then
760 PCESetsOfCodes := TStringList.Create;
761 idx := CodeSetIndex(CodeType);
762 if(idx >= 0) then
763 begin
764 inc(idx);
765 while((idx < PCESetsOfCodes.Count) and
766 (copy(PCESetsOfCodes[idx],1,SOCHeaderLen) <> SetOfCodesHeader)) do
767 begin
768 if(Piece(PCESetsOfCodes[idx], U, 1) = ID) then
769 begin
770 Result := Piece(PCESetsOfCodes[idx], U, 2);
771 break;
772 end;
773 inc(idx);
774 end;
775 end;
776 end;
777end;
778
779procedure PCELoadORComboData(dest: TORComboBox; GetMinMax: boolean; var Min, Max: integer);
780var
781 idx: integer;
782
783begin
784 if(dest.items.count < 1) then
785 begin
786 dest.Clear;
787 GetPCECodes(dest.Items, dest.Tag);
788 dest.itemindex := 0;
789 if(GetMinMax) and (dest.Items.Count > 0) then
790 begin
791 idx := dest.Tag div 10;
792 if(idx > 0) and (idx < 8) then
793 begin
794 if(ListMinMax[idx, mmFont] <> integer(dest.Font.Handle)) then
795 begin
796 GetComboBoxMinMax(dest, Min, Max);
797 ListMinMax[idx, mmMin] := Min;
798 ListMinMax[idx, mmMax] := Max;
799 end
800 else
801 begin
802 Min := ListMinMax[idx, mmMin];
803 Max := ListMinMax[idx, mmMax];
804 end;
805 end;
806 end;
807 end;
808end;
809
810procedure PCELoadORCombo(dest: TORComboBox);
811var
812 tmp: integer;
813
814begin
815 PCELoadORComboData(dest, FALSE, tmp, tmp);
816end;
817
818procedure PCELoadORCombo(dest: TORComboBox; var Min, Max: integer);
819begin
820 PCELoadORComboData(dest, TRUE, Min, Max);
821end;
822
823function GetPCEDisplayText(ID: string; Tag: integer): string;
824var
825 Hdr: string;
826 idx: integer;
827 TempSL: TStringList;
828
829begin
830 Result := '';
831 if(Tag = TAG_HISTLOC) then
832 begin
833 if(not assigned(HistLocations)) then
834 begin
835 HistLocations := TORStringList.Create;
836 LoadHistLocations(HistLocations);
837 HistLocations.SortByPiece(2);
838 HistLocations.Insert(0,'0');
839 end;
840 idx := HistLocations.IndexOfPiece(ID);
841 if(idx >= 0) then
842 Result := Piece(HistLocations[idx], U, 2);
843 end
844 else
845 begin
846 if(not assigned(PCESetsOfCodes)) then
847 PCESetsOfCodes := TStringList.Create;
848 Hdr := SetOfCodesHeader + IntToStr(Tag);
849 idx := PCESetsOfCodes.IndexOf(Hdr);
850 if(idx < 0) then
851 begin
852 TempSL := TStringList.Create;
853 try
854 case Tag of
855 TAG_IMMSERIES: LoadImmSeriesItems(TempSL);
856 TAG_IMMREACTION: LoadImmReactionItems(TempSL);
857 TAG_SKRESULTS: LoadSkResultsItems(TempSL);
858 TAG_PEDLEVEL: LoadPEDLevelItems(TempSL);
859 TAG_HFLEVEL: LoadHFLevelItems(TempSL);
860 TAG_XAMRESULTS: LoadXAMResultsItems(TempSL);
861 else
862 KillObj(@TempSL);
863 end;
864 if(assigned(TempSL)) then
865 begin
866 idx := PCESetsOfCodes.Add(Hdr);
867 PCESetsOfCodes.AddStrings(TempSL);
868 end;
869 finally
870 KillObj(@TempSL);
871 end;
872 end;
873 if(idx >= 0) then
874 begin
875 inc(idx);
876 while((idx < PCESetsOfCodes.Count) and
877 (copy(PCESetsOfCodes[idx],1,SOCHeaderLen) <> SetOfCodesHeader)) do
878 begin
879 if(Piece(PCESetsOfCodes[idx], U, 1) = ID) then
880 begin
881 Result := Piece(PCESetsOfCodes[idx], U, 2);
882 break;
883 end;
884 inc(idx);
885 end;
886 end;
887 end;
888end;
889
890function GetPCEDataText(Cat: TPCEDataCat; Code, Category, Narrative: string;
891 PrimaryDiag: boolean = FALSE; Qty: integer = 0): string;
892begin
893 Result := '';
894 case Cat of
895 pdcVisit: if Code <> '' then Result := Category + ' ' + Narrative;
896 pdcDiag: begin
897 Result := Narrative;
898// if PrimaryDiag then Result := Result + ' (Primary)'; <-- original line. //kt 8/8/2007
899 if PrimaryDiag then Result := Result + DKLangConstW('uPCE_xPrimaryx'); //kt added 8/8/2007
900 end;
901 pdcProc: begin
902 Result := Narrative;
903// if Qty > 1 then Result := Result + ' (' + IntToStr(Qty) + ' times)'; <-- original line. //kt 8/8/2007
904 if Qty > 1 then Result := Result + ' (' + IntToStr(Qty) + DKLangConstW('uPCE_timesx'); //kt added 8/8/2007
905 end;
906 else Result := Narrative;
907 end;
908end;
909
910procedure SetDefaultProvider(ProviderList: TPCEProviderList; APCEData: TPCEData);
911var
912 SIEN, tmp: string;
913 DefUser, AUser: Int64;
914 UserName: string;
915
916begin
917 DefUser := Encounter.Provider;
918 if(DefUser <> 0) and (InvalidPCEProviderTxt(DefUser, APCEData.PersonClassDate) <> '') then
919 DefUser := 0;
920 if(DefUser <> 0) then
921 begin
922 AUser := DefUser;
923 UserName := Encounter.ProviderName;
924 end
925 else
926 if(InvalidPCEProviderTxt(User.DUZ, APCEData.PersonClassDate) = '') then
927 begin
928 AUser := User.DUZ;
929 UserName := User.Name;
930 end
931 else
932 begin
933 AUser := 0;
934 UserName := '';
935 end;
936 if(AUser = 0) then
937 ProviderList.FPendingUser := ''
938 else
939 ProviderList.FPendingUser := IntToStr(AUser) + U + UserName;
940 ProviderList.FPendingDefault := '';
941 tmp := DefaultProvider(APCEData.Location, DefUser, APCEData.PersonClassDate, APCEData.NoteIEN);
942 SIEN := IntToStr(StrToIntDef(Piece(tmp,U,1),0));
943 if(SIEN <> '0') then
944 begin
945 if(CheckActivePerson(SIEN, APCEData.PersonClassDate)) then
946 begin
947 if(piece(TIUSiteParams, U, 8) = '1') and // Check to see if DEFAULT PRIMARY PROVIDER is by Location
948 (SIEN = IntToStr(User.DUZ)) then
949 ProviderList.AddProvider(SIEN, Piece(tmp,U,2) ,TRUE)
950 else
951 ProviderList.FPendingDefault := tmp;
952 end;
953 end;
954end;
955
956function ValidateGAFDate(var GafDate: TFMDateTime): string;
957var
958 DateMsg: string;
959 OKDate: TFMDateTime;
960
961begin
962 Result := '';
963 if(Patient.DateDied > 0) and (FMToday > Patient.DateDied) then
964 begin
965// DateMsg := 'Date of Death'; <-- original line. //kt 8/8/2007
966 DateMsg := DKLangConstW('uPCE_Date_of_Death'); //kt added 8/8/2007
967 OKDate := Patient.DateDied;
968 end
969 else
970 begin
971// DateMsg := 'Today'; <-- original line. //kt 8/8/2007
972 DateMsg := DKLangConstW('uPCE_Today'); //kt added 8/8/2007
973 OKDate := FMToday;
974 end;
975 if(GafDate <= 0) then
976 begin
977// Result := 'A date is required to enter a GAF score. Date Determined changed to ' + DateMsg + '.'; <-- original line. //kt 8/8/2007
978 Result := DKLangConstW('uPCE_A_date_is_required_to_enter_a_GAF_scorex__Date_Determined_changed_to') + DateMsg + '.'; //kt added 8/8/2007
979 GafDate := OKDate;
980 end
981 else
982 if(Patient.DateDied > 0) and (GafDate > Patient.DateDied) then
983 begin
984// Result := 'This patient died ' + FormatFMDateTime('mmm dd, yyyy hh:nn', Patient.DateDied) + <-- original line. //kt 8/8/2007
985 Result := DKLangConstW('uPCE_This_patient_died')+' ' + FormatFMDateTime(DKLangConstW('uPCE_mmm_ddx_yyyy_hhxnn'), Patient.DateDied) + //kt added 8/8/2007
986// '. Date GAF determined can not ' + CRLF + <-- original line. //kt 8/8/2007
987 DKLangConstW('uPCE_x__Date_GAF_determined_can_not') + CRLF + //kt added 8/8/2007
988// 'be later than the date of death, and has been changed to ' + DateMsg + '.'; <-- original line. //kt 8/8/2007
989 DKLangConstW('uPCE_be_later_than_the_date_of_deathx_and_has_been_changed_to') + DateMsg + '.'; //kt added 8/8/2007
990 GafDate := OKDate;
991 end;
992end;
993
994procedure GetVitalsFromDate(VitalStr: TStrings; PCEObj: TPCEData);
995var
996 dte: TFMDateTime;
997
998begin
999 if(PCEObj.IsSecondaryVisit) then
1000 dte := PCEObj.NoteDateTime
1001 else
1002 dte := PCEObj.DateTime;
1003 GetVitalsFromEncDateTime(VitalStr, Patient.DFN, dte);
1004end;
1005
1006procedure GetVitalsFromNote(VitalStr: TStrings; PCEObj: TPCEData; ANoteIEN: Int64);
1007begin
1008 if(PCEObj.IsSecondaryVisit) then
1009 GetVitalsFromEncDateTime(VitalStr, Patient.DFN, PCEObj.NoteDateTime)
1010 else
1011 GetVitalFromNoteIEN(VitalStr, Patient.DFN, ANoteIEN);
1012end;
1013
1014{ TPCEItem methods ------------------------------------------------------------------------- }
1015
1016//function TPCEItem.DelimitedStr2: string;
1017//added: 6/17/98
1018//By: Robert Bott
1019//Location: ISL
1020//Purpose: Return comment string to be passed in RPC call.
1021function TPCEItem.DelimitedStr2: string;
1022{created delimited string to pass to broker}
1023begin
1024 If Comment = '' then
1025 begin
1026 result := 'COM' + U + IntToStr(UNxtCommSeqNum) + U + NoPCEValue;
1027 end
1028 else
1029 begin
1030 Result := 'COM' + U + IntToStr(UNxtCommSeqNum) + U + Comment;
1031 end;
1032
1033 Inc(UNxtCommSeqNum); //set up for next comment
1034end;
1035
1036procedure TPCEItem.Assign(Src: TPCEItem);
1037begin
1038 FDelete := Src.FDelete;
1039 FSend := Src.FSend;
1040 Code := Src.Code;
1041 Category := Src.Category;
1042 Narrative := Src.Narrative;
1043 Provider := Src.Provider;
1044 Comment := Src.Comment;
1045end;
1046
1047procedure TPCEItem.SetComment(const Value: String);
1048begin
1049 FComment := Value;
1050 while (length(FComment) > 0) and (FComment[1] = '?') do
1051 delete(FComment,1,1);
1052end;
1053
1054
1055//procedure TPCEItem.Clear;
1056//modified: 6/17/98
1057//By: Robert Bott
1058//Location: ISL
1059//Purpose: Add Comments to PCE Items.
1060procedure TPCEItem.Clear;
1061{clear fields(properties) of class}
1062begin
1063 FDelete := False;
1064 FSend := False;
1065 Code := '';
1066 Category := '';
1067 Narrative := '';
1068 Provider := 0;
1069 Comment := '';
1070end;
1071
1072//function TPCEItem.DelimitedStr: string;
1073//modified: 6/17/98
1074//By: Robert Bott
1075//Location: ISL
1076//Purpose: Add Comments to PCE Items.
1077function TPCEItem.DelimitedStr: string;
1078{created delimited string to pass to broker}
1079var
1080 DelFlag: Char;
1081begin
1082 if FDelete then DelFlag := '-' else DelFlag := '+';
1083 Result := DelFlag + U + Code + U + Category + U + Narrative;
1084end;
1085
1086function TPCEItem.ItemStr: string;
1087{returns string to be assigned to Tlist in PCEData object}
1088begin
1089 Result := Narrative;
1090end;
1091
1092function TPCEItem.Match(AnItem: TPCEItem): Boolean;
1093{checks for match of Code, Category. and Item}
1094begin
1095 Result := False;
1096 if (Code = AnItem.Code) and (Category = AnItem.Category) and (Narrative = AnItem.Narrative)
1097 then Result := True;
1098end;
1099
1100function TPCEItem.HasCPTStr: string;
1101begin
1102 Result := '';
1103end;
1104
1105//procedure TPCEItem.SetFromString(const x: string);
1106//modified: 6/17/98
1107//By: Robert Bott
1108//Location: ISL
1109//Purpose: Add Comments to PCE Items.
1110procedure TPCEItem.SetFromString(const x: string);
1111{ sets fields to pieces passed from server: TYP ^ Code ^ Category ^ Narrative }
1112begin
1113 Code := Piece(x, U, pnumCode);
1114 Category := Piece(x, U, pnumCategory);
1115 Narrative := Piece(x, U, pnumNarrative);
1116 Provider := StrToInt64Def(Piece(x, U, pnumProvider), 0);
1117 Comment := Piece(x, U, pnumComment);
1118end;
1119
1120
1121{ TPCEExams methods ------------------------------------------------------------------------- }
1122
1123procedure TPCEExams.Assign(Src: TPCEItem);
1124begin
1125 inherited Assign(Src);
1126 Results := TPCEExams(Src).Results;
1127 if Results = '' then Results := NoPCEValue;
1128end;
1129
1130procedure TPCEExams.Clear;
1131{clear fields(properties) of class}
1132begin
1133 inherited Clear;
1134// Provider := 0;
1135 Results := NoPCEValue;
1136end;
1137
1138//function TPCEExams.DelimitedStr: string;
1139//modified: 6/17/98
1140//By: Robert Bott
1141//Location: ISL
1142//Purpose: Add Comments to PCE Items.
1143function TPCEExams.DelimitedStr: string;
1144{created delimited string to pass to broker}
1145begin
1146 Result := inherited DelimitedStr;
1147 //Result := 'XAM' + Result + U + Results + U + IntToStr(Provider) +U + U + U +
1148 Result := 'XAM' + Result + U + Results + U +U + U + U +
1149 U + IntToStr(UNxtCommSeqNum);
1150end;
1151
1152(*function TPCEExams.delimitedStrC: string;
1153begin
1154 Result := inherited DelimitedStr;
1155 Result := 'XAM' + Result + U + Results + U + IntToStr(Provider) +U + U + U +
1156 U + comment;
1157end;
1158*)
1159function TPCEExams.HasCPTStr: string;
1160begin
1161 Result := Code + ';AUTTEXAM(';
1162end;
1163
1164function TPCEExams.ItemStr: string;
1165{returns string to be assigned to Tlist in PCEData object}
1166begin
1167 if(Results <> NoPCEValue) then
1168 Result := GetPCECodeString(TAG_XAMRESULTS, Results)
1169 else
1170 Result := '';
1171 Result := Result + U + inherited ItemStr;
1172end;
1173
1174procedure TPCEExams.SetFromString(const x: string);
1175{ sets fields to pieces passed from server: TYP ^ Code ^ Category ^ Narrative ^ Qty ^ Prov }
1176begin
1177 inherited SetFromString(x);
1178// Provider := StrToInt64Def(Piece(x, U, pnumProvider), 0);
1179 Results := Piece(x, U, pnumExamResults);
1180 If results = '' then results := NoPCEValue;
1181end;
1182
1183
1184{ TPCESkin methods ------------------------------------------------------------------------- }
1185
1186procedure TPCESkin.Assign(Src: TPCEItem);
1187var
1188 SKSrc: TPCESkin;
1189
1190begin
1191 inherited Assign(Src);
1192 SKSrc := TPCESkin(Src);
1193 Results := SKSrc.Results;
1194 Reading := SKSrc.Reading;
1195 DTRead := SKSrc.DTRead;
1196 DTGiven := SKSrc.DTGiven;
1197 if Results = '' then Results := NoPCEValue;
1198end;
1199
1200procedure TPCESkin.Clear;
1201{clear fields(properties) of class}
1202begin
1203 inherited Clear;
1204// Provider := 0;
1205 Results := NoPCEValue;
1206 Reading := 0;
1207 DTRead := 0.0; //What should dates be ititialized to?
1208 DTGiven := 0.0;
1209end;
1210
1211//function TPCESkin.DelimitedStr: string;
1212//modified: 6/17/98
1213//By: Robert Bott
1214//Location: ISL
1215//Purpose: Add Comments to PCE Items.
1216function TPCESkin.DelimitedStr: string;
1217{created delimited string to pass to broker}
1218begin
1219 Result := inherited DelimitedStr;
1220 //Result := 'SK' + Result + U + results + U + IntToStr(Provider) + U +
1221 Result := 'SK' + Result + U + results + U + U +
1222 IntToStr(Reading) + U + U + U + IntToStr(UNxtCommSeqNum);
1223 //+ FloatToStr(DTRead) + U + FloatToStr(DTGiven);
1224end;
1225
1226(*function TPCESkin.delimitedStrC: string;
1227begin
1228 Result := inherited DelimitedStr;
1229 Result := 'SK' + Result + U + results + U + IntToStr(Provider) + U +
1230 IntToStr(Reading) + U + U + U + comment;
1231end;
1232*)
1233function TPCESkin.HasCPTStr: string;
1234begin
1235 Result := Code + ';AUTTSK(';
1236end;
1237
1238function TPCESkin.ItemStr: string;
1239{returns string to be assigned to Tlist in PCEData object}
1240begin
1241 if(Results <> NoPCEValue) then
1242 Result := GetPCECodeString(TAG_SKRESULTS, Results)
1243 else
1244 Result := '';
1245 Result := Result + U;
1246 if(Reading <> 0) then
1247 Result := Result + IntToStr(Reading);
1248 Result := Result + U + inherited ItemStr;
1249end;
1250
1251procedure TPCESkin.SetFromString(const x: string);
1252{ sets fields to pieces passed from server: TYP ^ Code ^ Category ^ Narrative ^ Qty ^ Prov }
1253var
1254 sRead, sDTRead, sDTGiven: String;
1255begin
1256 inherited SetFromString(x);
1257// Provider := StrToInt64Def(Piece(x, U, pnumProvider), 0);
1258 Results := Piece(x, U, pnumSkinResults);
1259 sRead := Piece(x, U, pnumSkinReading);
1260 sDTRead := Piece(x, U, pnumSkinDTRead);
1261 sDtGiven := Piece(x, U, pnumSkinDTGiven);
1262 If results = '' then results := NoPCEValue;
1263
1264 if sRead <> '' then
1265 Reading := StrToInt(sRead);
1266 if sDTRead <> '' then
1267 DTRead := StrToFMDateTime(sDTRead);
1268 if sDTGiven <> '' then
1269 DTGiven := StrToFMDateTime(sDTGiven);
1270
1271end;
1272
1273
1274{ TPCEHealth methods ------------------------------------------------------------------------- }
1275
1276procedure TPCEHealth.Assign(Src: TPCEItem);
1277begin
1278 inherited Assign(Src);
1279 Level := TPCEHealth(Src).Level;
1280 if Level = '' then Level := NoPCEValue;
1281end;
1282
1283procedure TPCEHealth.Clear;
1284{clear fields(properties) of class}
1285begin
1286 inherited Clear;
1287// Provider := 0;
1288 Level := NoPCEValue;
1289end;
1290
1291//function TPCEHealth.DelimitedStr: string;
1292//modified: 6/17/98
1293//By: Robert Bott
1294//Location: ISL
1295//Purpose: Add Comments to PCE Items.
1296function TPCEHealth.DelimitedStr: string;
1297{created delimited string to pass to broker}
1298begin
1299 Result := inherited DelimitedStr;
1300// Result := 'HF' + Result + U + Level + U + IntToStr(Provider) + U + U + U +
1301 Result := 'HF' + Result + U + Level + U + U + U + U +
1302 U + IntToStr(UNxtCommSeqNum)+ U + GecRem;
1303end;
1304
1305(*function TPCEHealth.delimitedStrC: string;
1306begin
1307 Result := inherited DelimitedStr;
1308 Result := 'HF' + Result + U + Level + U + IntToStr(Provider) + U + U + U +
1309 U + comment;
1310end;
1311*)
1312function TPCEHealth.HasCPTStr: string;
1313begin
1314 Result := Code + ';AUTTHF(';
1315end;
1316
1317function TPCEHealth.ItemStr: string;
1318{returns string to be assigned to Tlist in PCEData object}
1319begin
1320 if(Level <> NoPCEValue) then
1321 Result := GetPCECodeString(TAG_HFLEVEL, Level)
1322 else
1323 Result := '';
1324 Result := Result + U + inherited ItemStr;
1325end;
1326
1327procedure TPCEHealth.SetFromString(const x: string);
1328{ sets fields to pieces passed from server: TYP ^ Code ^ Category ^ Narrative ^ Qty ^ Prov }
1329begin
1330 inherited SetFromString(x);
1331// Provider := StrToInt64Def(Piece(x, U, pnumProvider), 0);
1332 Level := Piece(x, U, pnumHFLevel);
1333 if level = '' then level := NoPCEValue;
1334end;
1335
1336
1337{ TPCEImm methods ------------------------------------------------------------------------- }
1338
1339procedure TPCEImm.Assign(Src: TPCEItem);
1340var
1341 IMMSrc: TPCEImm;
1342
1343begin
1344 inherited Assign(Src);
1345 IMMSrc := TPCEImm(Src);
1346 Series := IMMSrc.Series;
1347 Reaction := IMMSrc.Reaction;
1348 Refused := IMMSrc.Refused;
1349 Contraindicated := IMMSrc.Contraindicated;
1350 if Series = '' then Series := NoPCEValue;
1351 if Reaction ='' then Reaction := NoPCEValue;
1352end;
1353
1354procedure TPCEImm.Clear;
1355{clear fields(properties) of class}
1356begin
1357 inherited Clear;
1358// Provider := 0;
1359 Series := NoPCEValue;
1360 Reaction := NoPCEValue;
1361 Refused := False; //not currently used
1362 Contraindicated := false;
1363end;
1364
1365//function TPCEImm.DelimitedStr: string;
1366//modified: 6/17/98
1367//By: Robert Bott
1368//Location: ISL
1369//Purpose: Add Comments to PCE Items.
1370function TPCEImm.DelimitedStr: string;
1371{created delimited string to pass to broker}
1372begin
1373 Result := inherited DelimitedStr;
1374 //Result := 'IMM' + Result + U + Series + U + IntToStr(Provider) + U + Reaction;
1375 Result := 'IMM' + Result + U + Series + U + U + Reaction;
1376 if Contraindicated then Result := Result + U + '1'
1377 else Result := Result + U + '0';
1378 Result := Result + U + U + IntToStr(UNxtCommSeqNum);
1379 {the following two lines are not yet implemented in PCE side}
1380 //if Refused then Result := Result + U + '1'
1381 //else Result := Result + U + '0';
1382end;
1383
1384(*function TPCEImm.delimitedStrC: string;
1385begin
1386 Result := inherited DelimitedStr;
1387 Result := 'IMM' + Result + U + Series + U + IntToStr(Provider) + U + Reaction;
1388 if Contraindicated then Result := Result + U + '1'
1389 else Result := Result + U + '0';
1390 Result := Result + U + U + comment;
1391 {the following two lines are not yet implemented in PCE side}
1392 //if Refused then Result := Result + U + '1'
1393 //else Result := Result + U + '0';
1394end;
1395*)
1396function TPCEImm.HasCPTStr: string;
1397begin
1398 Result := Code + ';AUTTIMM(';
1399end;
1400
1401function TPCEImm.ItemStr: string;
1402{returns string to be assigned to Tlist in PCEData object}
1403begin
1404 if(Series <> NoPCEValue) then
1405 Result := GetPCECodeString(TAG_IMMSERIES, Series)
1406 else
1407 Result := '';
1408 Result := Result + U;
1409 if(Reaction <> NoPCEValue) then
1410 Result := Result + GetPCECodeString(TAG_IMMREACTION, Reaction);
1411 Result := Result + U;
1412 if(Contraindicated) then
1413 Result := Result + 'X';
1414 Result := Result + U + inherited ItemStr;
1415end;
1416
1417procedure TPCEImm.SetFromString(const x: string);
1418{ sets fields to pieces passed from server: TYP ^ Code ^ Category ^ Narrative ^ Qty ^ Prov }
1419var
1420 temp: String;
1421begin
1422 inherited SetFromString(x);
1423// Provider := StrToInt64Def(Piece(x, U, pnumProvider), 0);
1424 Series := Piece(x, U, pnumImmSeries);
1425 Reaction := Piece(x, U, pnumImmReaction);
1426 temp := Piece(x, U, pnumImmRefused);
1427 if temp = '1' then refused := true else refused := false;
1428 temp := Piece(x, U, pnumImmContra);
1429 if temp = '1' then Contraindicated := true else Contraindicated := false;
1430 if Series = '' then series := NoPCEValue;
1431 if Reaction ='' then reaction := NoPCEValue;
1432end;
1433
1434
1435
1436{ TPCEProc methods ------------------------------------------------------------------------- }
1437
1438procedure TPCEProc.Assign(Src: TPCEItem);
1439begin
1440 inherited Assign(Src);
1441 Quantity := TPCEProc(Src).Quantity;
1442 Modifiers := TPCEProc(Src).Modifiers;
1443 Provider := TPCEProc(Src).Provider;
1444end;
1445
1446procedure TPCEProc.Clear;
1447{clear fields(properties) of class}
1448begin
1449 inherited Clear;
1450 Quantity := 0;
1451 Modifiers := '';
1452// Provider := 0;
1453 Provider := 0;
1454end;
1455
1456procedure TPCEProc.CopyProc(Dest: TPCEProc);
1457begin
1458 Dest.FDelete := FDelete;
1459 Dest.FSend := Fsend; //flag to send to broker
1460// Dest.Provider := Provider;
1461 Dest.Provider := Provider;
1462 Dest.Code := Code;
1463 Dest.Category := Category;
1464 Dest.Narrative := Narrative;
1465 Dest.Comment := Comment;
1466 Dest.Modifiers := Modifiers;
1467end;
1468
1469//function TPCEProc.DelimitedStr: string;
1470//modified: 6/17/98
1471//By: Robert Bott
1472//Location: ISL
1473//Purpose: Add Comments to PCE Items.
1474function TPCEProc.DelimitedStr: string;
1475var
1476 i, cnt: integer;
1477 Mods, ModIEN, tmpProv: string;
1478
1479{created delimited string to pass to broker}
1480begin
1481 i := 1;
1482 cnt := 0;
1483 Mods := '';
1484 repeat
1485 ModIEN := piece(Modifiers, ';', i);
1486 if(ModIEN <> '') then
1487 begin
1488 inc(cnt);
1489 Mods := Mods + ';' + ModifierCode(ModIEN) + '/' + ModIEN;
1490 inc(i);
1491 end;
1492 until (ModIEN = '');
1493
1494 Result := inherited DelimitedStr;
1495 if Provider > 0 then tmpProv := IntToStr(Provider) else tmpProv := '';
1496 Result := 'CPT' + Result + U + IntToStr(Quantity) + U + tmpProv
1497 + U + U + U + IntToStr(cnt) + Mods + U + IntToStr(UNxtCommSeqNum) + U;
1498 if Length(Result) > 250 then SetPiece(Result, U, 4, '');
1499end;
1500
1501(*function TPCEProc.delimitedStrC: string;
1502begin
1503 Result := inherited DelimitedStr;
1504 Result := 'CPT' + Result + U + IntToStr(Quantity) + U + IntToStr(Provider) +
1505 U + U + U + U + comment;
1506end;
1507*)
1508
1509function TPCEProc.Empty: boolean;
1510begin
1511 Result := (Code = '') and (Category = '') and (Narrative = '') and
1512 (Comment = '') and (Quantity = 0) and (Provider = 0) and (Modifiers = '');
1513end;
1514
1515(*function TPCEProc.Match(AnItem: TPCEProc): Boolean; {NEW CODE - v20 testing only - RV}
1516begin
1517 Result := inherited Match(AnItem) and (Modifiers = AnItem.Modifiers);
1518end;*)
1519
1520function TPCEProc.ModText: string;
1521var
1522 i: integer;
1523 tmp: string;
1524
1525begin
1526 Result := '';
1527 if(Modifiers <> '') then
1528 begin
1529 i := 1;
1530 repeat
1531 tmp := Piece(Modifiers,';',i);
1532 if(tmp <> '') then
1533 begin
1534 tmp := ModifierName(tmp);
1535 Result := Result + ' - ' + tmp;
1536 end;
1537 inc(i);
1538 until (tmp = '');
1539 end;
1540end;
1541
1542function TPCEProc.ItemStr: string;
1543{returns string to be assigned to Tlist in PCEData object}
1544begin
1545 if(Quantity > 1) then
1546// Result := IntToStr(Quantity) + ' times' <-- original line. //kt 8/8/2007
1547 Result := IntToStr(Quantity) + DKLangConstW('uPCE_times') //kt added 8/8/2007
1548 else
1549 Result := '';
1550 Result := Result + U + inherited ItemStr + ModText;
1551end;
1552
1553procedure TPCEProc.SetFromString(const x: string);
1554var
1555 i, cnt: integer;
1556 Mods: string;
1557{ sets fields to pieces passed from server: TYP ^ Code ^ Category ^ Narrative ^ Qty ^ Prov }
1558begin
1559 inherited SetFromString(x);
1560 Quantity := StrToIntDef(Piece(x, U, pnumProcQty), 1);
1561// Provider := StrToInt64Def(Piece(x, U, pnumProvider), 0);
1562 Provider := StrToInt64Def(Piece(x, U, pnumProvider), 0);
1563 Modifiers := '';
1564 Mods := Piece(x, U, pnumCPTMods);
1565 cnt := StrToIntDef(Piece(Mods, ';', 1), 0);
1566 if(cnt > 0) then
1567 for i := 1 to cnt do
1568 Modifiers := Modifiers + Piece(Piece(Mods, ';' , i+1), '/', 2) + ';';
1569end;
1570
1571
1572{ TPCEPat methods ------------------------------------------------------------------------- }
1573
1574procedure TPCEPat.Assign(Src: TPCEItem);
1575begin
1576 inherited Assign(Src);
1577 Level := TPCEPat(Src).Level;
1578 if Level = '' then Level := NoPCEValue;
1579end;
1580
1581procedure TPCEPat.Clear;
1582{clear fields(properties) of class}
1583begin
1584 inherited Clear;
1585// Provider := 0;
1586 Level := NoPCEValue;
1587end;
1588
1589//function TPCEPat.DelimitedStr: string;
1590//modified: 6/17/98
1591//By: Robert Bott
1592//Location: ISL
1593//Purpose: Add Comments to PCE Items.
1594function TPCEPat.DelimitedStr: string;
1595{created delimited string to pass to broker}
1596begin
1597 Result := inherited DelimitedStr;
1598 //Result := 'PED' + Result + U + Level + U + IntToStr(Provider) + U + U + U +
1599 Result := 'PED' + Result + U + Level + U+ U + U + U +
1600 U + IntToStr(UNxtCommSeqNum);
1601end;
1602
1603(*function TPCEPat.delimitedStrC: string;
1604begin
1605 Result := inherited DelimitedStr;
1606 Result := 'PED' + Result + U + Level + U + IntToStr(Provider) + U + U + U +
1607 U + comment;
1608end;
1609*)
1610function TPCEPat.HasCPTStr: string;
1611begin
1612 Result := Code + ';AUTTEDT(';
1613end;
1614
1615function TPCEPat.ItemStr: string;
1616{returns string to be assigned to Tlist in PCEData object}
1617begin
1618 if(Level <> NoPCEValue) then
1619 Result := GetPCECodeString(TAG_PEDLEVEL, Level)
1620 else
1621 Result := '';
1622 Result := Result + U + inherited ItemStr;
1623end;
1624
1625procedure TPCEPat.SetFromString(const x: string);
1626{ sets fields to pieces passed from server: TYP ^ Code ^ Category ^ Narrative ^ Qty ^ Prov }
1627begin
1628 inherited SetFromString(x);
1629// Provider := StrToInt64Def(Piece(x, U, pnumProvider), 0);
1630 Level := Piece(x, U, pnumPEDLevel);
1631 if level = '' then level := NoPCEValue;
1632end;
1633
1634{ TPCEDiag methods ------------------------------------------------------------------------- }
1635
1636procedure TPCEDiag.Assign(Src: TPCEItem);
1637begin
1638 inherited Assign(Src);
1639 Primary := TPCEDiag(Src).Primary;
1640 AddProb := TPCEDiag(Src).AddProb;
1641end;
1642
1643//procedure TPCEDiag.Clear;
1644//modified: 6/17/98
1645//By: Robert Bott
1646//Location: ISL
1647//Purpose: Clear a diagnosis object.
1648procedure TPCEDiag.Clear;
1649{clear fields(properties) of class}
1650begin
1651 inherited Clear;
1652 Primary := False;
1653 //Provider := 0;
1654 AddProb := False;
1655end;
1656
1657//function TPCEDiag.DelimitedStr: string;
1658//modified: 6/17/98
1659//By: Robert Bott
1660//Location: ISL
1661//Purpose: Create delimited string to pass to Broker.
1662function TPCEDiag.DelimitedStr: string;
1663{created delimited string to pass to broker}
1664var
1665 ProviderStr: string; {jm 9/8/99}
1666begin
1667 Result := inherited DelimitedStr;
1668 if(AddProb) then
1669 ProviderStr := IntToStr(fProvider)
1670 else
1671 ProviderStr := '';
1672 Result := 'POV' + Result + U + BOOLCHAR[Primary] + U + ProviderStr + U +
1673 BOOLCHAR[AddProb] + U + U + U;
1674 if(SaveComment) then Result := Result + IntToStr(UNxtCommSeqNum);
1675 if Length(Result) > 250 then SetPiece(Result, U, 4, '');
1676end;
1677
1678function TPCEDiag.DelimitedStr2: string;
1679begin
1680 If Comment = '' then
1681 begin
1682 SaveComment := (OldComment <> '') or (not AddProb);
1683 if(SaveComment) then
1684 result := 'COM' + U + IntToStr(UNxtCommSeqNum) + U + NoPCEValue
1685 else
1686 result := '';
1687 end
1688 else
1689 begin
1690 Result := 'COM' + U + IntToStr(UNxtCommSeqNum) + U + Comment;
1691 SaveComment := TRUE;
1692 end;
1693 Inc(UNxtCommSeqNum);
1694end;
1695
1696(*function TPCEDiag.DelimitedStrC: string;
1697{created delimited string for internal use - keep comment in same string.}
1698begin
1699 Result := inherited DelimitedStr;
1700 Result := 'POV' + Result + U + BOOLCHAR[Primary] + U + IntToStr(Provider)+
1701 U + BOOLCHAR[AddProb] + U + U + U + comment;
1702end;
1703*)
1704function TPCEDiag.ItemStr: string;
1705{returns string to be assigned to Tlist in PCEData object}
1706begin
1707 if Primary then
1708// Result := 'Primary' <-- original line. //kt 8/8/2007
1709 Result := DKLangConstW('uPCE_Primary') //kt added 8/8/2007
1710 else
1711// Result := 'Secondary'; <-- original line. //kt 8/8/2007
1712 Result := DKLangConstW('uPCE_Secondary'); //kt added 8/8/2007
1713// This may change in the future if we add a check box to the grid
1714 if(AddProb) then
1715// Result := 'Add' + U + Result <-- original line. //kt 8/8/2007
1716 Result := DKLangConstW('uPCE_Add') + U + Result //kt added 8/8/2007
1717 else
1718 Result := U + Result;
1719
1720 Result := Result + U + inherited ItemStr;
1721end;
1722
1723procedure TPCEDiag.Send;
1724//marks diagnosis to be sent;
1725begin
1726 Fsend := True;
1727end;
1728
1729//procedure TPCEDiag.SetFromString(const x: string);
1730//modified: 6/17/98
1731//By: Robert Bott
1732//Location: ISL
1733//Purpose: Sets fields to pieces passed from server.
1734procedure TPCEDiag.SetFromString(const x: string);
1735{ sets fields to pieces passed from server: TYP ^ Code ^ Category ^ Narrative ^ Primary ^ ^ ^ Comment }
1736begin
1737 inherited SetFromString(x);
1738 OldComment := Comment;
1739 Primary := (Piece(x, U, pnumDiagPrimary) = '1');
1740 //Provider := StrToInt64Def(Piece(x, U, pnumProvider),0);
1741 AddProb := (Piece(x, U, pnumDiagAdd2PL) = '1');
1742end;
1743
1744{ TPCEData methods ------------------------------------------------------------------------- }
1745
1746constructor TPCEData.Create;
1747begin
1748 FDiagnoses := TList.Create;
1749 FProcedures := TList.Create;
1750 FImmunizations := TList.Create;
1751 FSkinTests := TList.Create;
1752 FVisitType := TPCEProc.Create;
1753 FPatientEds := TList.Create;
1754 FHealthFactors := TList.Create;
1755 fExams := TList.Create;
1756 FProviders := TPCEProviderList.Create;
1757 FSCRelated := SCC_NA;
1758 FAORelated := SCC_NA;
1759 FIRRelated := SCC_NA;
1760 FECRelated := SCC_NA;
1761 FMSTRelated := SCC_NA;
1762 FHNCRelated := SCC_NA;
1763 FCVRelated := SCC_NA;
1764 FSCChanged := False;
1765end;
1766
1767destructor TPCEData.Destroy;
1768var
1769 i: Integer;
1770begin
1771 with FDiagnoses do for i := 0 to Count - 1 do TPCEDiag(Items[i]).Free;
1772 with FProcedures do for i := 0 to Count - 1 do TPCEProc(Items[i]).Free;
1773 with FImmunizations do for i := 0 to Count - 1 do TPCEImm(Items[i]).Free;
1774 with FSkinTests do for i := 0 to Count - 1 do TPCESkin(Items[i]).Free;
1775 with FPatientEds do for i := 0 to Count - 1 do TPCEPat(Items[i]).Free;
1776 with FHealthFactors do for i := 0 to Count - 1 do TPCEHealth(Items[i]).Free;
1777 with FExams do for i := 0 to Count - 1 do TPCEExams(Items[i]).Free;
1778 FVisitType.Free;
1779 FDiagnoses.Free;
1780 FProcedures.Free;
1781 FImmunizations.Free;
1782 FSkinTests.free;
1783 FPatientEds.Free;
1784 FHealthFactors.Free;
1785 FExams.Free;
1786 FProviders.Free;
1787 inherited Destroy;
1788end;
1789
1790procedure TPCEData.Clear;
1791
1792 procedure ClearList(AList: TList);
1793 var
1794 i: Integer;
1795
1796 begin
1797 for i := 0 to AList.Count - 1 do
1798 TObject(AList[i]).Free;
1799 AList.Clear;
1800 end;
1801
1802begin
1803 FEncDateTime := 0;
1804 FNoteDateTime := 0;
1805 FEncLocation := 0;
1806 FEncSvcCat := 'A';
1807 FEncInpatient := FALSE;
1808 FEncUseCurr := FALSE;
1809 FStandAlone := FALSE;
1810 FStandAloneLoaded := FALSE;
1811 FParent := '';
1812 FHistoricalLocation := '';
1813 FSCRelated := SCC_NA;
1814 FAORelated := SCC_NA;
1815 FIRRelated := SCC_NA;
1816 FECRelated := SCC_NA;
1817 FMSTRelated := SCC_NA;
1818 FHNCRelated := SCC_NA;
1819 FCVRelated := SCC_NA;
1820
1821 ClearList(FDiagnoses);
1822 ClearList(FProcedures);
1823 ClearList(FImmunizations);
1824 ClearList(FSkinTests);
1825 ClearList(FPatientEds);
1826 ClearList(FHealthFactors);
1827 ClearList(FExams);
1828
1829 FVisitType.Clear;
1830 FProviders.Clear;
1831 FSCChanged := False;
1832 FNoteIEN := 0;
1833 FNoteTitle := 0;
1834end;
1835
1836procedure TPCEData.CopyDiagnoses(Dest: TStrings);
1837begin
1838 CopyPCEItems(FDiagnoses, Dest, TPCEDiag);
1839end;
1840
1841procedure TPCEData.CopyProcedures(Dest: TStrings);
1842begin
1843 CopyPCEItems(FProcedures, Dest, TPCEProc);
1844end;
1845
1846procedure TPCEData.CopyImmunizations(Dest: TStrings);
1847begin
1848 CopyPCEItems(FImmunizations, Dest, TPCEImm);
1849end;
1850
1851procedure TPCEData.CopySkinTests(Dest: TStrings);
1852begin
1853 CopyPCEItems(FSkinTests, Dest, TPCESkin);
1854end;
1855
1856procedure TPCEData.CopyPatientEds(Dest: TStrings);
1857begin
1858 CopyPCEItems(FPatientEds, Dest, TPCEPat);
1859end;
1860
1861procedure TPCEData.CopyHealthFactors(Dest: TStrings);
1862begin
1863 CopyPCEItems(FHealthFactors, Dest, TPCEHealth);
1864end;
1865
1866procedure TPCEData.CopyExams(Dest: TStrings);
1867begin
1868 CopyPCEItems(FExams, Dest, TPCEExams);
1869end;
1870
1871function TPCEData.GetVisitString: string;
1872begin
1873 Result := IntToStr(FEncLocation) + ';' + FloatToStr(VisitDateTime) + ';' + FEncSvcCat;
1874end;
1875
1876function TPCEData.GetCPTRequired: Boolean;
1877begin
1878 Result := (([ndDiag, ndProc] * NeededPCEData) <> []);
1879end;
1880
1881procedure TPCEData.PCEForNote(NoteIEN: Integer; EditObj: TPCEData);
1882(*const
1883 NULL_STR = '';
1884begin
1885 PCEForNote(NoteIEN, EditObj, NULL_STR);
1886end;
1887
1888procedure TPCEData.PCEForNote(NoteIEN: Integer; EditObj: TPCEData; DCSummAdmitString: string);*)
1889var
1890 i, j: Integer;
1891 TmpCat, TmpVStr: string;
1892 x: string;
1893 DoCopy, IsVisit: Boolean;
1894 PCEList, VisitTypeList: TStringList;
1895 ADiagnosis: TPCEDiag;
1896 AProcedure: TPCEProc;
1897 AImmunization: TPCEImm;
1898 ASkinTest: TPCESkin;
1899 APatientEd: TPCEPat;
1900 AHealthFactor: TPCEHealth;
1901 AExam: TPCEExams;
1902 FileVStr: string;
1903 FileIEN: integer;
1904 GetCat, DoRestore: boolean;
1905 FRestDate: TFMDateTime;
1906// AProvider: TPCEProvider; {6/9/99}
1907
1908 function SCCValue(x: string): Integer;
1909 begin
1910 Result := SCC_NA;
1911 if Piece(x, U, 3) = '1' then Result := SCC_YES;
1912 if Piece(x, U, 3) = '0' then Result := SCC_NO;
1913 end;
1914
1915 function AppendComment(x: string): String;
1916 begin
1917 //check for comment append string if a comment exists
1918 If (((i+1) <= (PCEList.Count - 1)) and (Copy(PCEList[(i+1)], 1, 3) = 'COM')) then
1919 begin
1920 //remove last piece (comment sequence number) from x.
1921 While x[length(x)] <> U do
1922 x := Copy(X,0,(length(x)-1));
1923 //add last piece of comment to x
1924 x := X + Piece (PCEList[(i+1)],U,3);
1925 end;
1926 result := x;
1927 end;
1928
1929begin
1930(* if DCSummAdmitString <> '' then
1931 TmpVStr := DCSummAdmitString
1932 else*) if(NoteIEN < 1) then
1933 TmpVStr := Encounter.VisitStr
1934 else
1935 begin
1936 TmpVStr := VisitStrForNote(NoteIEN);
1937 if(FEncSvcCat = #0) then
1938 GetCat :=TRUE
1939 else
1940 if(GetVisitString = '0;0;A') then
1941 begin
1942 FEncLocation := StrToIntDef(Piece(TmpVStr, ';', 1), 0);
1943 FEncDateTime := StrToFloatDef(Piece(TmpVStr, ';', 2),0);
1944 GetCat :=TRUE
1945 end
1946 else
1947 GetCat := FALSE;
1948 if(GetCat) then
1949 begin
1950 TmpCat := Piece(TmpVStr, ';', 3);
1951 if(TmpCat <> '') then
1952 FEncSvcCat := TmpCat[1];
1953 end;
1954 end;
1955
1956 if(assigned(EditObj)) then
1957 begin
1958 if(copy(TmpVStr,1,2) <> '0;') and // has location
1959 (pos(';0;',TmpVStr) = 0) and // has time
1960 (EditObj.GetVisitString = TmpVStr) then
1961 begin
1962 if(FEncSvcCat = 'H') and (FEncInpatient) then
1963 DoCopy := (FNoteDateTime = EditObj.FNoteDateTime)
1964 else
1965 DoCopy := TRUE;
1966 if(DoCopy) then
1967 begin
1968 if(EditObj <> Self) then
1969 begin
1970 EditObj.CopyPCEData(Self);
1971 FNoteTitle := 0;
1972 FNoteIEN := 0;
1973 end;
1974 exit;
1975 end;
1976 end;
1977 end;
1978
1979 TmpCat := Piece(TmpVStr, ';', 3);
1980 if(TmpCat <> '') then
1981 FEncSvcCat := TmpCat[1]
1982 else
1983 FEncSvcCat := #0;
1984 FEncLocation := StrToIntDef(Piece(TmpVStr,';',1),0);
1985 FEncDateTime := StrToFloatDef(Piece(TmpVStr, ';', 2),0);
1986
1987 if(IsSecondaryVisit and (FEncLocation > 0)) then
1988 begin
1989 FileIEN := USE_CURRENT_VISITSTR;
1990 FileVStr := IntToStr(FEncLocation) + ';' + FloatToStr(FNoteDateTime) + ';' +
1991 GetLocSecondaryVisitCode(FEncLocation);
1992 DoRestore := TRUE;
1993 FRestDate := FEncDateTime;
1994 end
1995 else
1996 begin
1997 DoRestore := FALSE;
1998 FRestDate := 0;
1999 FileIEN := NoteIEN;
2000(* if DCSummAdmitString <> '' then
2001 FileVStr := DCSummAdmitString
2002 else*) if(FileIEN < 0) then
2003 FileVStr := Encounter.VisitStr
2004 else
2005 FileVStr := '';
2006 end;
2007
2008 Clear;
2009 PCEList := TStringList.Create;
2010 VisitTypeList := TStringList.Create;
2011 try
2012 LoadPCEDataForNote(PCEList, FileIEN, FileVStr); // calls broker RPC to load data
2013 FNoteIEN := NoteIEN;
2014 for i := 0 to PCEList.Count - 1 do
2015 begin
2016 x := PCEList[i];
2017 if Copy(x, 1, 4) = 'HDR^' then // HDR ^ Inpatient ^ ProcReq ^ VStr ^ Provider
2018 {header information-------------------------------------------------------------}
2019 begin
2020 FEncInpatient := Piece(x, U, 2) = '1';
2021 //FCPTRequired := Piece(x, U, 3) = '1';
2022 //FNoteHasCPT := Piece(x, U, 6) = '1'; //4/21/99 error! PIECE 3 = cptRequired, not HasCPT!
2023 FEncLocation := StrToIntDef(Piece(Piece(x, U, 4), ';', 1), 0);
2024 if DoRestore then
2025 begin
2026 FEncSvcCat := 'H';
2027 FEncDateTime := FRestDate;
2028 FNoteDateTime := MakeFMDateTime(Piece(Piece(x, U, 4), ';', 2));
2029 end
2030 else
2031 begin
2032 FEncDateTime := MakeFMDateTime(Piece(Piece(x, U, 4), ';', 2));
2033 FEncSvcCat := CharAt(Piece(Piece(x, U, 4), ';', 3), 1);
2034 end;
2035 //FEncProvider := StrToInt64Def(Piece(x, U, 5), 0);
2036 ListVisitTypeByLoc(VisitTypeList, FEncLocation, FEncDateTime);
2037 //set the values needed fot the RPCs
2038 SetRPCEncLocation(FEncLocation);
2039// SetRPCEncDateTime(FEncDateTime);
2040 end;
2041 {visit information--------------------------------------------------------------}
2042 if Copy(x, 1, 7) = 'VST^DT^' then
2043 begin
2044 if DoRestore then
2045 begin
2046 FEncDateTime := FRestDate;
2047 FNoteDateTime := MakeFMDateTime(Piece(x, U, 3));
2048 end
2049 else
2050 FEncDateTime := MakeFMDateTime(Piece(x, U, 3));
2051 end;
2052 if Copy(x, 1, 7) = 'VST^HL^' then FEncLocation := StrToIntDef(Piece(x, U, 3), 0);
2053 if Copy(x, 1, 7) = 'VST^VC^' then
2054 begin
2055 if DoRestore then
2056 FEncSvcCat := 'H'
2057 else
2058 FEncSvcCat := CharAt(x, 8);
2059 end;
2060 if Copy(x, 1, 7) = 'VST^PS^' then FEncInpatient := CharAt(x, 8) = '1';
2061 {6/10/99}//if Copy(x, 1, 4) = 'PRV^' then FEncProvider := StrToInt64Def(Piece(x, U, 2), 0);
2062 if Copy(x, 1, 7) = 'VST^SC^' then FSCRelated := SCCValue(x);
2063 if Copy(x, 1, 7) = 'VST^AO^' then FAORelated := SCCValue(x);
2064 if Copy(x, 1, 7) = 'VST^IR^' then FIRRelated := SCCValue(x);
2065 if Copy(x, 1, 7) = 'VST^EC^' then FECRelated := SCCValue(x);
2066 if Copy(x, 1, 8) = 'VST^MST^' then FMSTRelated := SCCValue(x);
2067// if HNCOK and (Copy(x, 1, 8) = 'VST^HNC^') then
2068 if Copy(x, 1, 8) = 'VST^HNC^' then FHNCRelated := SCCValue(x);
2069 if Copy(x, 1, 7) = 'VST^CV^' then FCVRelated := SCCValue(x);
2070 if (Copy(x, 1, 3) = 'PRV') and (CharAt(x, 4) <> '-') then
2071 {Providers---------------------------------------------------------------------}
2072 begin
2073 FProviders.Add(x);
2074 end;
2075
2076 if (Copy(x, 1, 3) = 'POV') and (CharAt(x, 4) <> '-') then
2077 {'POV'=Diagnosis--------------------------------------------------------------}
2078 begin
2079 //check for comment append string if a comment exists
2080 x := AppendComment(x);
2081 ADiagnosis := TPCEDiag.Create;
2082 ADiagnosis.SetFromString(x);
2083 FDiagnoses.Add(ADiagnosis);
2084 end;
2085 if (Copy(x, 1, 3) = 'CPT') and (CharAt(x, 4) <> '-') then
2086 {CPT (procedure) information--------------------------------------------------}
2087 begin
2088 x := AppendComment(x);
2089
2090 IsVisit := False;
2091 with VisitTypeList do for j := 0 to Count - 1 do
2092 if Pieces(x, U, 2, 4) = Strings[j] then IsVisit := True;
2093 if IsVisit and (FVisitType.Code = '') then FVisitType.SetFromString(x) else
2094 begin
2095 AProcedure := TPCEProc.Create;
2096 AProcedure.SetFromString(x);
2097 AProcedure.fIsOldProcedure := TRUE;
2098 FProcedures.Add(AProcedure);
2099 end; {if IsVisit}
2100 end; {if Copy}
2101 if (Copy(x, 1, 3) = 'IMM') and (CharAt(x, 4) <> '-') then
2102 {Immunizations ---------------------------------------------------------------}
2103 begin
2104 x := AppendComment(x);
2105 AImmunization := TPCEImm.Create;
2106 AImmunization.SetFromString(x);
2107 FImmunizations.Add(AImmunization);
2108 end;
2109 if (Copy(x, 1, 2) = 'SK') and (CharAt(x, 3) <> '-') then
2110 {Skin Tests-------------------------------------------------------------------}
2111 begin
2112 x := AppendComment(x);
2113 ASkinTest := TPCESkin.Create;
2114 ASkinTest.SetFromString(x);
2115 FSkinTests.Add(ASkinTest);
2116 end;
2117 if (Copy(x, 1, 3) = 'PED') and (CharAt(x, 3) <> '-') then
2118 {Patient Educations------------------------------------------------------------}
2119 begin
2120 x := AppendComment(x);
2121 APatientEd := TPCEpat.Create;
2122 APatientEd.SetFromString(x);
2123 FpatientEds.Add(APatientEd);
2124 end;
2125 if (Copy(x, 1, 2) = 'HF') and (CharAt(x, 3) <> '-') then
2126 {Health Factors----------------------------------------------------------------}
2127 begin
2128 x := AppendComment(x);
2129 AHealthFactor := TPCEHealth.Create;
2130 AHealthFactor.SetFromString(x);
2131 FHealthFactors.Add(AHealthFactor);
2132 end;
2133 if (Copy(x, 1, 3) = 'XAM') and (CharAt(x, 3) <> '-') then
2134 {Exams ------------------------------------------------------------------------}
2135 begin
2136 x := AppendComment(x);
2137 AExam := TPCEExams.Create;
2138 AExam.SetFromString(x);
2139 FExams.Add(AExam);
2140 end;
2141
2142 end;
2143 finally
2144 PCEList.Free;
2145 VisitTypeList.Free;
2146 end;
2147end;
2148
2149//procedure TPCEData.Save;
2150//modified: 6/17/98
2151//By: Robert Bott
2152//Location: ISL
2153//Purpose: Add Comments to PCE Items.
2154procedure TPCEData.Save;
2155{ pass the changes to the encounter to DATA2PCE,
2156 Pieces: Subscript^Code^Qualifier^Category^Narrative^Delete }
2157var
2158 i: Integer;
2159 x, AVisitStr, EncName, Temp2: string;
2160 PCEList: TStringList;
2161 FileCat: char;
2162 FileDate: TFMDateTime;
2163 FileNoteIEN: integer;
2164 dstring1,dstring2: pchar; //used to separate former DelimitedStr variable
2165 // into two strings, the second being for the comment.
2166
2167begin
2168 PCEList := TStringList.Create;
2169 UNxtCommSeqNum := 1;
2170 try
2171 with PCEList do
2172 begin
2173 if(IsSecondaryVisit) then
2174 begin
2175 FileCat := GetLocSecondaryVisitCode(FEncLocation);
2176 FileDate := FNoteDateTime;
2177 FileNoteIEN := NoteIEN;
2178 if((NoteIEN > 0) and ((FParent = '') or (FParent = '0'))) then
2179 FParent := GetVisitIEN(NoteIEN);
2180 end
2181 else
2182 begin
2183 FileCat := FEncSvcCat;
2184 FileDate := FEncDateTime;
2185 FileNoteIEN := 0;
2186 end;
2187 AVisitStr := IntToStr(FEncLocation) + ';' + FloatToStr(FileDate) + ';' + FileCat;
2188 Add('HDR^' + BOOLCHAR[FEncInpatient] + U + U + AVisitStr);
2189// Add('HDR^' + BOOLCHAR[FEncInpatient] + U + BOOLCHAR[FNoteHasCPT] + U + AVisitStr);
2190 // set up list that can be passed via broker to set up array for DATA2PCE
2191 Add('VST^DT^' + FloatToStr(FileDate)); // Encounter Date/Time
2192 Add('VST^PT^' + Patient.DFN); // Encounter Patient //*DFN*
2193 if(FEncLocation > 0) then
2194 Add('VST^HL^' + IntToStr(FEncLocation)); // Encounter Location
2195 Add('VST^VC^' + FileCat); // Encounter Service Category
2196 if(StrToIntDef(FParent,0) > 0) then
2197 Add('VST^PR^' + FParent); // Parent for secondary visit
2198 if(FileCat = 'E') and (FHistoricalLocation <> '') then
2199 Add('VST^OL^' + FHistoricalLocation); // Outside Location
2200
2201 //Add('PRV^' + IntToStr(FEncProvider)); // Encounter Provider
2202 //Add('PRV^' + IntToStr(UProvider.IEN)); // Encounter Provider
2203 {with FProviders do for i := 0 to Count - 1 do with TPCEProvider(Items[i]) do
2204 begin
2205 PCEList.Add(DelimitedStr);
2206 end;}
2207 PCEList.AddStrings(FProviders);
2208
2209 if FSCChanged then
2210 begin
2211 if FSCRelated <> SCC_NA then Add('VST^SC^' + IntToStr(FSCRelated));
2212 if FAORelated <> SCC_NA then Add('VST^AO^' + IntToStr(FAORelated));
2213 if FIRRelated <> SCC_NA then Add('VST^IR^' + IntToStr(FIRRelated));
2214 if FECRelated <> SCC_NA then Add('VST^EC^' + IntToStr(FECRelated));
2215 if FMSTRelated <> SCC_NA then Add('VST^MST^' + IntToStr(FMSTRelated));
2216// if HNCOK and (FHNCRelated <> SCC_NA) then
2217 if FHNCRelated <> SCC_NA then Add('VST^HNC^' + IntToStr(FHNCRelated));
2218 if FCVRelated <> SCC_NA then Add('VST^CV^' + IntToStr(FCVRelated));
2219 end;
2220 with FDiagnoses do for i := 0 to Count - 1 do with TPCEDiag(Items[i]) do
2221 if FSend then
2222 begin
2223 Temp2 := DelimitedStr2; // Call first to make sure SaveComment is set.
2224 if(SaveComment) then
2225 dec(UNxtCommSeqNum);
2226 fProvider := FProviders.PCEProvider;
2227 // Provides user with list of dx when signing orders - Billing Aware
2228 PCEList.Add(DelimitedStr);
2229 if(SaveComment) then
2230 begin
2231 inc(UNxtCommSeqNum);
2232 if(Temp2 <> '') then
2233 PCEList.Add(Temp2);
2234 end;
2235 end;
2236 with FProcedures do for i := 0 to Count - 1 do with TPCEProc(Items[i]) do
2237 if FSend then
2238 begin
2239 PCEList.Add(DelimitedStr);
2240 PCEList.Add(DelimitedStr2);
2241 end;
2242 with FImmunizations do for i := 0 to Count - 1 do with TPCEImm(Items[i]) do
2243 if FSend then
2244 begin
2245 PCEList.Add(DelimitedStr);
2246 PCEList.Add(DelimitedStr2);
2247 end;
2248 with FSkinTests do for i := 0 to Count - 1 do with TPCESkin(Items[i]) do
2249 if FSend then
2250 begin
2251 PCEList.Add(DelimitedStr);
2252 PCEList.Add(DelimitedStr2);
2253 end;
2254 with FPatientEds do for i := 0 to Count - 1 do with TPCEPat(Items[i]) do
2255 if FSend then
2256 begin
2257 PCEList.Add(DelimitedStr);
2258 PCEList.Add(DelimitedStr2);
2259 end;
2260 with FHealthFactors do for i := 0 to Count - 1 do with TPCEHealth(Items[i]) do
2261 if FSend then
2262 begin
2263 PCEList.Add(DelimitedStr);
2264 PCEList.Add(DelimitedStr2);
2265 end;
2266 with FExams do for i := 0 to Count - 1 do with TPCEExams(Items[i]) do
2267 if FSend then
2268 begin
2269 PCEList.Add(DelimitedStr);
2270 PCEList.Add(DelimitedStr2);
2271 end;
2272
2273 with FVisitType do
2274 begin
2275 if Code = '' then Fsend := false;
2276 if FSend then
2277 begin
2278 PCEList.Add(DelimitedStr);
2279 PCEList.Add(DelimitedStr2);
2280 end;
2281 end;
2282 // call DATA2PCE (in background)
2283 SavePCEData(PCEList, FileNoteIEN, FEncLocation);
2284
2285 // turn off 'Send' flags and remove items that were deleted
2286 with FDiagnoses do for i := Count - 1 downto 0 do with TPCEDiag(Items[i]) do
2287 begin
2288 FSend := False;
2289 if FDelete then
2290 begin
2291 TPCEDiag(Items[i]).Free;
2292 Delete(i);
2293 end;
2294 end;
2295 with FProcedures do for i := Count - 1 downto 0 do with TPCEProc(Items[i]) do
2296 begin
2297 FSend := False;
2298 if FDelete then
2299 begin
2300 TPCEProc(Items[i]).Free;
2301 Delete(i);
2302 end;
2303 end;
2304 with FImmunizations do for i := Count - 1 downto 0 do with TPCEImm(Items[i]) do
2305 begin
2306 FSend := False;
2307 if FDelete then
2308 begin
2309 TPCEImm(Items[i]).Free;
2310 Delete(i);
2311 end;
2312 end;
2313 with FSkinTests do for i := Count - 1 downto 0 do with TPCESkin(Items[i]) do
2314 begin
2315 FSend := False;
2316 if FDelete then
2317 begin
2318 TPCESkin(Items[i]).Free;
2319 Delete(i);
2320 end;
2321 end;
2322 with FPatientEds do for i := Count - 1 downto 0 do with TPCEPat(Items[i]) do
2323 begin
2324 FSend := False;
2325 if FDelete then
2326 begin
2327 TPCEPat(Items[i]).Free;
2328 Delete(i);
2329 end;
2330 end;
2331 with FHealthFactors do for i := Count - 1 downto 0 do with TPCEHealth(Items[i]) do
2332 begin
2333 FSend := False;
2334 if FDelete then
2335 begin
2336 TPCEHealth(Items[i]).Free;
2337 Delete(i);
2338 end;
2339 end;
2340 with FExams do for i := Count - 1 downto 0 do with TPCEExams(Items[i]) do
2341 begin
2342 FSend := False;
2343 if FDelete then
2344 begin
2345 TPCEExams(Items[i]).Free;
2346 Delete(i);
2347 end;
2348 end;
2349
2350 for i := FProviders.Count - 1 downto 0 do
2351 begin
2352 if(FProviders.ProviderData[i].Delete) then
2353 FProviders.Delete(i);
2354 end;
2355
2356 if FVisitType.FDelete then FVisitType.Clear else FVisitType.FSend := False;
2357 end; {with PCEList}
2358 //if (FProcedures.Count > 0) or (FVisitType.Code <> '') then FCPTRequired := False;
2359
2360 // update the Changes object
2361 EncName := FormatFMDateTime('mmm dd,yy hh:nn', FileDate);
2362 x := StrVisitType;
2363 if Length(x) > 0 then Changes.Add(CH_PCE, 'V' + AVisitStr, x, EncName, CH_SIGN_NA);
2364 x := StrProcedures;
2365 if Length(x) > 0 then Changes.Add(CH_PCE, 'P' + AVisitStr, x, EncName, CH_SIGN_NA);
2366 x := StrDiagnoses;
2367 if Length(x) > 0 then Changes.Add(CH_PCE, 'D' + AVisitStr, x, EncName, CH_SIGN_NA);
2368 x := StrImmunizations;
2369 if Length(x) > 0 then Changes.Add(CH_PCE, 'I' + AVisitStr, x, EncName, CH_SIGN_NA);
2370 x := StrSkinTests;
2371 if Length(x) > 0 then Changes.Add(CH_PCE, 'S' + AVisitStr, x, EncName, CH_SIGN_NA);
2372 x := StrPatientEds;
2373 if Length(x) > 0 then Changes.Add(CH_PCE, 'A' + AVisitStr, x, EncName, CH_SIGN_NA);
2374 x := StrHealthFactors;
2375 if Length(x) > 0 then Changes.Add(CH_PCE, 'H' + AVisitStr, x, EncName, CH_SIGN_NA);
2376 x := StrExams;
2377 if Length(x) > 0 then Changes.Add(CH_PCE, 'E' + AVisitStr, x, EncName, CH_SIGN_NA);
2378
2379
2380 finally
2381 PCEList.Free;
2382 end;
2383end;
2384
2385function TPCEData.MatchItem(AList: TList; AnItem: TPCEItem): Integer;
2386{ return index in AList of matching item }
2387var
2388 i: Integer;
2389begin
2390 Result := -1;
2391// with AList do for i := 0 to Count - 1 do with TPCEItem(Items[i]) do if Match(AnItem) and MatchProvider(AnItem)then
2392 with AList do for i := 0 to Count - 1 do with TPCEItem(Items[i]) do if Match(AnItem) and MatchProvider(AnItem)then
2393// with AList do for i := 0 to Count - 1 do with TPCEItem(Items[i]) do if Match(AnItem) then
2394 begin
2395 Result := i;
2396 break;
2397 end;
2398end;
2399
2400procedure TPCEData.MarkDeletions(PreList: TList; PostList: TStrings);
2401{mark items that need deleted}
2402var
2403 i, j: Integer;
2404 MatchFound: Boolean;
2405 PreItem, PostItem: TPCEItem;
2406begin
2407 with PreList do for i := 0 to Count - 1 do
2408 begin
2409 PreItem := TPCEItem(Items[i]);
2410 MatchFound := False;
2411 with PostList do for j := 0 to Count - 1 do
2412 begin
2413 PostItem := TPCEItem(Objects[j]);
2414// if (PreItem.Match(PostItem) and (PreItem.MatchProvider(PostItem))) then MatchFound := True;
2415 if (PreItem.Match(PostItem) and (PreItem.MatchProvider(PostItem))) then MatchFound := True;
2416// if (PreItem.Match(PostItem)) then MatchFound := True;
2417 end;
2418 if not MatchFound then
2419 begin
2420 PreItem.FDelete := True;
2421 PreItem.FSend := True;
2422 end;
2423 end;
2424end;
2425
2426procedure TPCEData.SetDiagnoses(Src: TStrings; FromForm: boolean = TRUE);
2427{ load diagnoses for this encounter into TPCEDiag records, assumes all diagnoses for the
2428 encounter will be listed in Src and marks those that are not in Src for deletion }
2429var
2430 i, MatchIndex: Integer;
2431 SrcDiagnosis, CurDiagnosis, PrimaryDiag: TPCEDiag;
2432begin
2433 if FromForm then MarkDeletions(FDiagnoses, Src);
2434 PrimaryDiag := nil;
2435 for i := 0 to Src.Count - 1 do
2436 begin
2437 SrcDiagnosis := TPCEDiag(Src.Objects[i]);
2438 MatchIndex := MatchItem(FDiagnoses, SrcDiagnosis);
2439 if MatchIndex > -1 then //found in fdiagnoses
2440 begin
2441 CurDiagnosis := TPCEDiag(FDiagnoses.Items[MatchIndex]);
2442 if ((SrcDiagnosis.Primary <> CurDiagnosis.Primary) or
2443 (SrcDiagnosis.Comment <> CurDiagnosis.Comment) or
2444 (SrcDiagnosis.AddProb <> CurDiagnosis.Addprob)) then
2445 begin
2446 CurDiagnosis.Primary := SrcDiagnosis.Primary;
2447 CurDiagnosis.Comment := SrcDiagnosis.Comment;
2448 CurDiagnosis.AddProb := SrcDiagnosis.AddProb;
2449 CurDiagnosis.FSend := True;
2450 end;
2451 end else
2452 begin
2453 CurDiagnosis := TPCEDiag.Create;
2454 CurDiagnosis.Assign(SrcDiagnosis);
2455 CurDiagnosis.FSend := True;
2456 FDiagnoses.Add(CurDiagnosis);
2457 end; {if MatchIndex}
2458 if(CurDiagnosis.Primary and (not assigned(PrimaryDiag))) then
2459 PrimaryDiag := CurDiagnosis;
2460 end; {for}
2461 if(assigned(PrimaryDiag)) then
2462 begin
2463 for i := 0 to FDiagnoses.Count - 1 do
2464 begin
2465 CurDiagnosis := TPCEDiag(FDiagnoses[i]);
2466 if(CurDiagnosis.Primary) and (CurDiagnosis <> PrimaryDiag) then
2467 begin
2468 CurDiagnosis.Primary := FALSE;
2469 CurDiagnosis.FSend := True;
2470 end;
2471 end;
2472 end;
2473end;
2474
2475procedure TPCEData.SetProcedures(Src: TStrings; FromForm: boolean = TRUE);
2476{ load Procedures for this encounter into TPCEProc records, assumes all Procedures for the
2477 encounter will be listed in Src and marks those that are not in Src for deletion }
2478var
2479 i, MatchIndex: Integer;
2480 SrcProcedure, CurProcedure, OldProcedure: TPCEProc;
2481begin
2482 if FromForm then MarkDeletions(FProcedures, Src);
2483 for i := 0 to Src.Count - 1 do
2484 begin
2485 SrcProcedure := TPCEProc(Src.Objects[i]);
2486 MatchIndex := MatchItem(FProcedures, SrcProcedure);
2487 if MatchIndex > -1 then
2488 begin
2489 CurProcedure := TPCEProc(FProcedures.Items[MatchIndex]);
2490(* if (SrcProcedure.Provider <> CurProcedure.Provider) then
2491 begin
2492 OldProcedure := TPCEProc.Create;
2493 OldProcedure.Assign(CurProcedure);
2494 OldProcedure.FDelete := TRUE;
2495 OldProcedure.FSend := TRUE;
2496 FProcedures.Add(OldProcedure);
2497 end;*)
2498 if (SrcProcedure.Quantity <> CurProcedure.Quantity) or
2499 (SrcProcedure.Provider <> CurProcedure.Provider) or
2500 (Curprocedure.Comment <> SrcProcedure.Comment) or
2501 (Curprocedure.Modifiers <> SrcProcedure.Modifiers)then
2502 begin
2503 OldProcedure := TPCEProc.Create;
2504 OldProcedure.Assign(CurProcedure);
2505 OldProcedure.FDelete := TRUE;
2506 OldProcedure.FSend := TRUE;
2507 FProcedures.Add(OldProcedure);
2508 CurProcedure.Quantity := SrcProcedure.Quantity;
2509 CurProcedure.Provider := SrcProcedure.Provider;
2510 CurProcedure.Comment := SrcProcedure.Comment;
2511 CurProcedure.Modifiers := SrcProcedure.Modifiers;
2512 CurProcedure.FSend := True;
2513 end;
2514 end else
2515 begin
2516 CurProcedure := TPCEProc.Create;
2517 CurProcedure.Assign(SrcProcedure);
2518 CurProcedure.FSend := True;
2519 FProcedures.Add(CurProcedure);
2520 end; {if MatchIndex}
2521 end; {for}
2522end;
2523
2524
2525
2526procedure TPCEData.SetImmunizations(Src: TStrings; FromForm: boolean = TRUE);
2527{ load Immunizations for this encounter into TPCEImm records, assumes all Immunizations for the
2528 encounter will be listed in Src and marks those that are not in Src for deletion }
2529var
2530 i, MatchIndex: Integer;
2531 SrcImmunization, CurImmunization: TPCEImm;
2532begin
2533 if FromForm then MarkDeletions(FImmunizations, Src);
2534 for i := 0 to Src.Count - 1 do
2535 begin
2536 SrcImmunization := TPCEImm(Src.Objects[i]);
2537 MatchIndex := MatchItem(FImmunizations, SrcImmunization);
2538 if MatchIndex > -1 then
2539 begin
2540 CurImmunization := TPCEImm(FImmunizations.Items[MatchIndex]);
2541
2542 //set null strings to NoPCEValue
2543 if SrcImmunization.Series = '' then SrcImmunization.Series := NoPCEValue;
2544 if SrcImmunization.Reaction = '' then SrcImmunization.Reaction := NoPCEValue;
2545 if CurImmunization.Series = '' then CurImmunization.Series := NoPCEValue;
2546 if CurImmunization.Reaction = '' then CurImmunization.Reaction := NoPCEValue;
2547
2548// if (SrcImmunization.Provider <> CurImmunization.Provider) or
2549 if(SrcImmunization.Series <> CurImmunization.Series) or
2550 (SrcImmunization.Reaction <> CurImmunization.Reaction) or
2551 (SrcImmunization.Refused <> CurImmunization.Refused) or
2552 (SrcImmunization.Contraindicated <> CurImmunization.Contraindicated) or
2553 (CurImmunization.Comment <> SrcImmunization.Comment)then
2554 begin
2555// CurImmunization.Provider := SrcImmunization.Provider;
2556 CurImmunization.Series := SrcImmunization.Series;
2557 CurImmunization.Reaction := SrcImmunization.Reaction;
2558 CurImmunization.Refused := SrcImmunization.Refused;
2559 CurImmunization.Contraindicated := SrcImmunization.Contraindicated;
2560 CurImmunization.Comment := SrcImmunization.Comment;
2561 CurImmunization.FSend := True;
2562 end;
2563 end else
2564 begin
2565 CurImmunization := TPCEImm.Create;
2566 CurImmunization.Assign(SrcImmunization);
2567 CurImmunization.FSend := True;
2568 FImmunizations.Add(CurImmunization);
2569 end; {if MatchIndex}
2570 end; {for}
2571end;
2572
2573procedure TPCEData.SetSkinTests(Src: TStrings; FromForm: boolean = TRUE);
2574{ load SkinTests for this encounter into TPCESkin records, assumes all SkinTests for the
2575 encounter will be listed in Src and marks those that are not in Src for deletion }
2576var
2577 i, MatchIndex: Integer;
2578 SrcSkinTest, CurSkinTest: TPCESkin;
2579begin
2580 if FromForm then MarkDeletions(FSKinTests, Src);
2581 for i := 0 to Src.Count - 1 do
2582 begin
2583 SrcSkinTest := TPCESkin(Src.Objects[i]);
2584 MatchIndex := MatchItem(FSKinTests, SrcSkinTest);
2585 if MatchIndex > -1 then
2586 begin
2587 CurSkinTest := TPCESKin(FSkinTests.Items[MatchIndex]);
2588 if CurSkinTest.Results = '' then CurSkinTest.Results := NoPCEValue;
2589 if SrcSkinTest.Results = '' then SrcSkinTest.Results := NoPCEValue;
2590// if (SrcSkinTest.Provider <> CurSkinTest.Provider) or
2591 if(SrcSkinTest.Results <> CurSkinTest.Results) or
2592 (SrcSkinTest.Reading <> CurSkinTest.Reading) or
2593 (CurSkinTest.Comment <> SrcSkinTest.Comment) then
2594 begin
2595// CurSkinTest.Provider := SrcSkinTest.Provider;
2596 CurSkinTest.Results := SrcSkinTest.Results;
2597 CurSkinTest.Reading := SrcSkinTest.Reading;
2598 CurSkinTest.Comment := SrcSkinTest.Comment;
2599 CurSkinTest.FSend := True;
2600 end;
2601 end else
2602 begin
2603 CurSKinTest := TPCESkin.Create;
2604 CurSkinTest.Assign(SrcSkinTest);
2605 CurSkinTest.FSend := True;
2606 FSkinTests.Add(CurSkinTest);
2607 end; {if MatchIndex}
2608 end; {for}
2609end;
2610
2611procedure TPCEData.SetPatientEds(Src: TStrings; FromForm: boolean = TRUE);
2612var
2613 i, MatchIndex: Integer;
2614 SrcPatientEd, CurPatientEd: TPCEPat;
2615begin
2616 if FromForm then MarkDeletions(FPatientEds, Src);
2617 for i := 0 to Src.Count - 1 do
2618 begin
2619 SrcPatientEd := TPCEPat(Src.Objects[i]);
2620 MatchIndex := MatchItem(FPatientEds, SrcPatientEd);
2621 if MatchIndex > -1 then
2622 begin
2623 CurPatientEd := TPCEPat(FPatientEds.Items[MatchIndex]);
2624
2625 if CurPatientEd.level = '' then CurPatientEd.level := NoPCEValue;
2626 if SrcPatientEd.level = '' then SrcPatientEd.level := NoPCEValue;
2627// if (SrcPatientEd.Provider <> CurPatientEd.Provider) or
2628 if(SrcPatientEd.Level <> CurPatientEd.Level) or
2629 (CurPatientEd.Comment <> SrcPatientEd.Comment) then
2630 begin
2631// CurPatientEd.Provider := SrcPatientEd.Provider;
2632 CurPatientEd.Level := SrcPatientEd.Level;
2633 CurPatientEd.Comment := SrcPatientEd.Comment;
2634 CurPatientEd.FSend := True;
2635 end;
2636 end else
2637 begin
2638 CurPatientEd := TPCEPat.Create;
2639 CurPatientEd.Assign(SrcPatientEd);
2640 CurPatientEd.FSend := True;
2641 FPatientEds.Add(CurPatientEd);
2642 end; {if MatchIndex}
2643 end; {for}
2644end;
2645
2646
2647procedure TPCEData.SetHealthFactors(Src: TStrings; FromForm: boolean = TRUE);
2648
2649var
2650 i, MatchIndex: Integer;
2651 SrcHealthFactor, CurHealthFactor: TPCEHealth;
2652begin
2653 if FromForm then MarkDeletions(FHealthFactors, Src);
2654 for i := 0 to Src.Count - 1 do
2655 begin
2656 SrcHealthFactor := TPCEHealth(Src.Objects[i]);
2657 MatchIndex := MatchItem(FHealthFactors, SrcHealthFactor);
2658 if MatchIndex > -1 then
2659 begin
2660 CurHealthFactor := TPCEHealth(FHealthFactors.Items[MatchIndex]);
2661
2662 if CurHealthFactor.level = '' then CurHealthFactor.level := NoPCEValue;
2663 if SrcHealthFactor.level = '' then SrcHealthFactor.level := NoPCEValue;
2664// if (SrcHealthFactor.Provider <> CurHealthFactor.Provider) or
2665 if(SrcHealthFactor.Level <> CurHealthFactor.Level) or
2666 (CurHealthFactor.Comment <> SrcHealthFactor.Comment) then
2667 begin
2668// CurHealthFactor.Provider := SrcHealthFactor.Provider;
2669 CurHealthFactor.Level := SrcHealthFactor.Level;
2670 CurHealthFactor.Comment := SrcHealthFactor.Comment;
2671 CurHealthFactor.FSend := True;
2672 end;
2673 if(SrcHealthFactor.GecRem <> CurHealthFactor.GecRem) then
2674 CurHealthFactor.GecRem := SrcHealthFactor.GecRem;
2675 end else
2676 begin
2677 CurHealthFactor := TPCEHealth.Create;
2678 CurHealthFactor.Assign(SrcHealthFactor);
2679 CurHealthFactor.FSend := True;
2680 CurHealthFactor.GecRem := SrcHealthFactor.GecRem;
2681 FHealthFactors.Add(CurHealthFactor);
2682 end; {if MatchIndex}
2683 end; {for}
2684end;
2685
2686
2687procedure TPCEData.SetExams(Src: TStrings; FromForm: boolean = TRUE);
2688
2689var
2690 i, MatchIndex: Integer;
2691 SrcExam, CurExam: TPCEExams;
2692begin
2693 if FromForm then MarkDeletions(FExams, Src);
2694 for i := 0 to Src.Count - 1 do
2695 begin
2696 SrcExam := TPCEExams(Src.Objects[i]);
2697 MatchIndex := MatchItem(FExams, SrcExam);
2698 if MatchIndex > -1 then
2699 begin
2700 CurExam := TPCEExams(FExams.Items[MatchIndex]);
2701 if CurExam.Results = '' then CurExam.Results := NoPCEValue;
2702 if SrcExam.Results = '' then SrcExam.Results := NoPCEValue;
2703// if (SrcExam.Provider <> CurExam.Provider) or
2704 if(SrcExam.Results <> CurExam.Results) or
2705 (CurExam.Comment <> SrcExam.Comment) then
2706 begin
2707// CurExam.Provider := SrcExam.Provider;
2708 CurExam.Results := SrcExam.Results;
2709 CurExam.Comment := SrcExam.Comment;
2710 CurExam.Fsend := True;
2711 end;
2712 end else
2713 begin
2714 CurExam := TPCEExams.Create;
2715 CurExam.Assign(SrcExam);
2716 CurExam.FSend := True;
2717 FExams.Add(CurExam);
2718 end; {if MatchIndex}
2719 end; {for}
2720end;
2721
2722
2723procedure TPCEData.SetVisitType(Value: TPCEProc);
2724var
2725 VisitDelete: TPCEProc;
2726begin
2727 if (not FVisitType.Match(Value)) or
2728 (FVisitType.Modifiers <> Value.Modifiers) then {causes CPT delete/re-add}
2729 begin
2730 if FVisitType.Code <> '' then // add old visit to procedures for deletion
2731 begin
2732 VisitDelete := TPCEProc.Create;
2733 VisitDelete.Assign(FVisitType);
2734 VisitDelete.FDelete := True;
2735 VisitDelete.FSend := True;
2736 FProcedures.Add(VisitDelete);
2737 end;
2738 FVisitType.Assign(Value);
2739 FVisitType.Quantity := 1;
2740 FVisitType.FSend := True;
2741 end;
2742end;
2743
2744procedure TPCEData.SetSCRelated(Value: Integer);
2745begin
2746 if Value <> FSCRelated then
2747 begin
2748 FSCRelated := Value;
2749 FSCChanged := True;
2750 end;
2751end;
2752
2753procedure TPCEData.SetAORelated(Value: Integer);
2754begin
2755 if Value <> FAORelated then
2756 begin
2757 FAORelated := Value;
2758 FSCChanged := True;
2759 end;
2760end;
2761
2762procedure TPCEData.SetIRRelated(Value: Integer);
2763begin
2764 if Value <> FIRRelated then
2765 begin
2766 FIRRelated := Value;
2767 FSCChanged := True;
2768 end;
2769end;
2770
2771procedure TPCEData.SetECRelated(Value: Integer);
2772begin
2773 if Value <> FECRelated then
2774 begin
2775 FECRelated := Value;
2776 FSCChanged := True;
2777 end;
2778end;
2779
2780procedure TPCEData.SetMSTRelated(Value: Integer);
2781begin
2782 if Value <> FMSTRelated then
2783 begin
2784 FMSTRelated := Value;
2785 FSCChanged := True;
2786 end;
2787end;
2788
2789procedure TPCEData.SetHNCRelated(Value: Integer);
2790begin
2791// if HNCOK and (Value <> FHNCRelated) then
2792 if Value <> FHNCRelated then
2793 begin
2794 FHNCRelated := Value;
2795 FSCChanged := True;
2796 end;
2797end;
2798
2799procedure TPCEData.SetCVRelated(Value: Integer);
2800begin
2801 if (Value <> FCVRelated) then
2802 begin
2803 FCVRelated := Value;
2804 FSCChanged := True;
2805 end;
2806end;
2807
2808procedure TPCEData.SetEncUseCurr(Value: Boolean);
2809begin
2810 FEncUseCurr := Value;
2811 if FEncUseCurr then
2812 begin
2813 FEncDateTime := Encounter.DateTime;
2814 FEncLocation := Encounter.Location;
2815 //need to add to full list of providers
2816 FEncSvcCat := Encounter.VisitCategory;
2817 FStandAlone := Encounter.StandAlone;
2818 FStandAloneLoaded := TRUE;
2819 //FCPTRequired := Encounter.StandAlone;
2820 FEncInpatient := Encounter.Inpatient;
2821 //if FEncInpatient then FCPTRequired := False;
2822 //SetDefaultProvider(FProviders, FEncLocation, FNoteIEN, PersonClassDate);
2823 end else
2824 begin
2825 FEncDateTime := 0;
2826 FEncLocation := 0;
2827 FStandAlone := FALSE;
2828 FStandAloneLoaded := FALSE;
2829 FProviders.PrimaryIdx := -1;
2830 FEncSvcCat := 'A';
2831 //FCPTRequired := False;
2832 FEncInpatient := False;
2833 end;
2834 //
2835 SetRPCEncLocation(FEncLocation);
2836// SetRPCEncDateTime(FEncDateTime);
2837end;
2838
2839function TPCEData.StrDiagnoses: string;
2840{ returns the list of diagnoses for this encounter as a single comma delimited string }
2841var
2842 i: Integer;
2843begin
2844 Result := '';
2845 with FDiagnoses do for i := 0 to Count - 1 do with TPCEDiag(Items[i]) do
2846 if not FDelete then
2847 Result := Result + GetPCEDataText(pdcDiag, Code, Category, Narrative, Primary) + ', ';
2848 //kt if Length(Result) > 0 then Result := PCEDataCatText[pdcDiag] + Copy(Result, 1, Length(Result) - 2);
2849 if Length(Result) > 0 then Result := PCEDataCatText(pdcDiag) + Copy(Result, 1, Length(Result) - 2);
2850end;
2851
2852function TPCEData.StrProcedures: string;
2853{ returns the list of procedures for this encounter as a single comma delimited string }
2854var
2855 i: Integer;
2856begin
2857 Result := '';
2858 with FProcedures do for i := 0 to Count - 1 do with TPCEProc(Items[i]) do
2859 if not FDelete then
2860 Result := Result + GetPCEDataText(pdcProc, Code, Category, Narrative, FALSE, Quantity) +
2861 ModText + ', ';
2862 //kt if Length(Result) > 0 then Result := PCEDataCatText[pdcProc] + Copy(Result, 1, Length(Result) - 2);
2863 if Length(Result) > 0 then Result := PCEDataCatText(pdcProc) + Copy(Result, 1, Length(Result) - 2);
2864end;
2865
2866function TPCEData.StrImmunizations: string;
2867{ returns the list of Immunizations for this encounter as a single comma delimited string }
2868var
2869 i: Integer;
2870begin
2871 Result := '';
2872 with FImmunizations do for i := 0 to Count - 1 do with TPCEImm(Items[i]) do
2873 if not FDelete then
2874 Result := Result + GetPCEDataText(pdcImm, Code, Category, Narrative) + ', ';
2875 //kt if Length(Result) > 0 then Result := PCEDataCatText[pdcImm] + Copy(Result, 1, Length(Result) - 2);
2876 if Length(Result) > 0 then Result := PCEDataCatText(pdcImm) + Copy(Result, 1, Length(Result) - 2);
2877end;
2878
2879
2880function TPCEData.StrSkinTests: string;
2881{ returns the list of Immunizations for this encounter as a single comma delimited string }
2882var
2883 i: Integer;
2884begin
2885 Result := '';
2886 with FSkinTests do for i := 0 to Count - 1 do with TPCESkin(Items[i]) do
2887 if not FDelete then
2888 Result := Result + GetPCEDataText(pdcSkin, Code, Category, Narrative) + ', ';
2889 //kt if Length(Result) > 0 then Result := PCEDataCatText[pdcSkin] + Copy(Result, 1, Length(Result) - 2);
2890 if Length(Result) > 0 then Result := PCEDataCatText(pdcSkin) + Copy(Result, 1, Length(Result) - 2);
2891end;
2892
2893function TPCEData.StrPatientEds: string;
2894var
2895 i: Integer;
2896begin
2897 Result := '';
2898 with FPatientEds do for i := 0 to Count - 1 do with TPCEPat(Items[i]) do
2899 if not FDelete then
2900 Result := Result + GetPCEDataText(pdcPED, Code, Category, Narrative) + ', ';
2901 //kt if Length(Result) > 0 then Result := PCEDataCatText[pdcPED] + Copy(Result, 1, Length(Result) - 2);
2902 if Length(Result) > 0 then Result := PCEDataCatText(pdcPED) + Copy(Result, 1, Length(Result) - 2);
2903end;
2904
2905function TPCEData.StrHealthFactors: string;
2906var
2907 i: Integer;
2908begin
2909 Result := '';
2910 with FHealthFactors do for i := 0 to Count - 1 do with TPCEHealth(Items[i]) do
2911 if not FDelete then
2912 Result := Result + GetPCEDataText(pdcHF, Code, Category, Narrative) + ', ';
2913 //kt if Length(Result) > 0 then Result := PCEDataCatText[pdcHF] + Copy(Result, 1, Length(Result) - 2);
2914 if Length(Result) > 0 then Result := PCEDataCatText(pdcHF) + Copy(Result, 1, Length(Result) - 2);
2915end;
2916
2917function TPCEData.StrExams: string;
2918var
2919 i: Integer;
2920begin
2921 Result := '';
2922 with FExams do for i := 0 to Count - 1 do with TPCEExams(Items[i]) do
2923 if not FDelete then
2924 Result := Result + GetPCEDataText(pdcExam, Code, Category, Narrative) + ', ';
2925 //kt if Length(Result) > 0 then Result := PCEDataCatText[pdcExam] + Copy(Result, 1, Length(Result) - 2);
2926 if Length(Result) > 0 then Result := PCEDataCatText(pdcExam) + Copy(Result, 1, Length(Result) - 2);
2927end;
2928
2929function TPCEData.StrVisitType(const ASCRelated, AAORelated, AIRRelated,
2930 AECRelated, AMSTRelated, AHNCRelated, ACVRelated: Integer): string;
2931{ returns as a string the type of encounter (according to CPT) & related contitions treated }
2932
2933 procedure AddTxt(txt: string);
2934 begin
2935 if(Result <> '') then
2936 Result := Result + ',';
2937 Result := Result + ' ' + txt;
2938 end;
2939
2940begin
2941 Result := '';
2942//if ASCRelated = SCC_YES then AddTxt('Service Connected Condition'); <-- original line. //kt 8/8/2007
2943 if ASCRelated = SCC_YES then AddTxt(DKLangConstW('uPCE_Service_Connected_Condition')); //kt added 8/8/2007
2944//if AAORelated = SCC_YES then AddTxt('Agent Orange Exposure'); <-- original line. //kt 8/8/2007
2945 if AAORelated = SCC_YES then AddTxt(DKLangConstW('uPCE_Agent_Orange_Exposure')); //kt added 8/8/2007
2946//if AIRRelated = SCC_YES then AddTxt('Ionizing Radiation Exposure'); <-- original line. //kt 8/8/2007
2947 if AIRRelated = SCC_YES then AddTxt(DKLangConstW('uPCE_Ionizing_Radiation_Exposure')); //kt added 8/8/2007
2948//if AECRelated = SCC_YES then AddTxt('Environmental Contaminants'); <-- original line. //kt 8/8/2007
2949 if AECRelated = SCC_YES then AddTxt(DKLangConstW('uPCE_Environmental_Contaminants')); //kt added 8/8/2007
2950 if AMSTRelated = SCC_YES then AddTxt('MST');//'Military Sexual Trauma';
2951// if HNCOK and (AHNCRelated = SCC_YES) then AddTxt('Head and/or Neck Cancer');
2952//if AHNCRelated = SCC_YES then AddTxt('Head and/or Neck Cancer'); <-- original line. //kt 8/8/2007
2953 if AHNCRelated = SCC_YES then AddTxt(DKLangConstW('uPCE_Head_andxor_Neck_Cancer')); //kt added 8/8/2007
2954//if ACVRelated = SCC_YES then AddTxt('Combat Veteran Related'); <-- original line. //kt 8/8/2007
2955 if ACVRelated = SCC_YES then AddTxt(DKLangConstW('uPCE_Combat_Veteran_Related')); //kt added 8/8/2007
2956//if Length(Result) > 0 then Result := ' related to: ' + Result; <-- original line. //kt 8/8/2007
2957 if Length(Result) > 0 then Result := DKLangConstW('uPCE_related_tox') + Result; //kt added 8/8/2007
2958// Result := Trim(Result);
2959end;
2960
2961function TPCEData.StrVisitType: string;
2962{ returns as a string the type of encounter (according to CPT) & related contitions treated }
2963begin
2964 Result := '';
2965 with FVisitType do
2966 begin
2967 Result := GetPCEDataText(pdcVisit, Code, Category, Narrative);
2968 if Length(ModText) > 0 then Result := Result + ModText + ', ';
2969 end;
2970 Result := Trim(Result + StrVisitType(FSCRelated, FAORelated, FIRRelated,
2971 FECRelated, FMSTRelated, FHNCRelated, FCVRelated));
2972end;
2973
2974function TPCEData.StandAlone: boolean;
2975var
2976 Sts: integer;
2977
2978begin
2979 if(not FStandAloneLoaded) and ((FNoteIEN > 0) or ((FEncLocation > 0) and (FEncDateTime > 0))) then
2980 begin
2981 Sts := HasVisit(FNoteIEN, FEncLocation, FEncDateTime);
2982 FStandAlone := (Sts <> 1);
2983 if(Sts >= 0) then
2984 FStandAloneLoaded := TRUE;
2985 end;
2986 Result := FStandAlone;
2987end;
2988
2989function TPCEData.getDocCount: Integer;
2990begin
2991 rESULT := 1;
2992// result := DocCount(vISIT);
2993end;
2994
2995{function TPCEItem.MatchProvider(AnItem: TPCEItem): Boolean;
2996begin
2997 Result := False;
2998 if (Provider = AnItem.Provider) then Result := True;
2999end;
3000}
3001function TPCEItem.MatchProvider(AnItem: TPCEItem): Boolean;
3002begin
3003 Result := False;
3004 if (Provider = AnItem.Provider) then Result := True;
3005end;
3006
3007function TPCEData.GetHasData: Boolean;
3008begin
3009 result := True;
3010 if ((FDiagnoses.count = 0)
3011 and (FProcedures.count = 0)
3012 and (FImmunizations.count = 0)
3013 and (FSkinTests.count = 0)
3014 and (FPatientEds.count = 0)
3015 and (FHealthFactors.count = 0)
3016 and (fExams.count = 0) and
3017 (FvisitType.Quantity = 0))then
3018 result := False;
3019end;
3020
3021procedure TPCEData.CopyPCEData(Dest: TPCEData);
3022begin
3023 Dest.Clear;
3024 Dest.FEncDateTime := FEncDateTime;
3025 Dest.FNoteDateTime := FNoteDateTime;
3026 Dest.FEncLocation := FEncLocation;
3027 Dest.FEncSvcCat := FEncSvcCat;
3028 Dest.FEncInpatient := FEncInpatient;
3029 Dest.FStandAlone := FStandAlone;
3030 Dest.FStandAloneLoaded := FStandAloneLoaded;
3031 Dest.FEncUseCurr := FEncUseCurr;
3032 Dest.FSCChanged := FSCChanged;
3033 Dest.FSCRelated := FSCRelated;
3034 Dest.FAORelated := FAORelated;
3035 Dest.FIRRelated := FIRRelated;
3036 Dest.FECRelated := FECRelated;
3037 Dest.FMSTRelated := FMSTRelated;
3038 Dest.FHNCRelated := FHNCRelated;
3039 Dest.FCVRelated := FCVRelated;
3040 FVisitType.CopyProc(Dest.VisitType);
3041 Dest.FProviders.Assign(FProviders);
3042
3043 CopyPCEItems(FDiagnoses, Dest.FDiagnoses, TPCEDiag);
3044 CopyPCEItems(FProcedures, Dest.FProcedures, TPCEProc);
3045 CopyPCEItems(FImmunizations, Dest.FImmunizations, TPCEImm);
3046 CopyPCEItems(FSkinTests, Dest.FSkinTests, TPCESkin);
3047 CopyPCEItems(FPatientEds, Dest.FPatientEds, TPCEPat);
3048 CopyPCEItems(FHealthFactors, Dest.FHealthFactors, TPCEHealth);
3049 CopyPCEItems(FExams, Dest.FExams, TPCEExams);
3050
3051 Dest.FNoteTitle := FNoteTitle;
3052 Dest.FNoteIEN := FNoteIEN;
3053 Dest.FParent := FParent;
3054 Dest.FHistoricalLocation := FHistoricalLocation;
3055end;
3056
3057function TPCEData.NeededPCEData: tRequiredPCEDataTypes;
3058var
3059 EC: TSCConditions;
3060 NeedSC: boolean;
3061 TmpLst: TStringList;
3062
3063begin
3064 Result := [];
3065 if(not FutureEncounter(Self)) then
3066 begin
3067// if(PromptForWorkload(FNoteIEN, FNoteTitle, FEncSvcCat, StandAlone) or CPTRequiredForNote(FNoteIEN)) then
3068 if(PromptForWorkload(FNoteIEN, FNoteTitle, FEncSvcCat, StandAlone)) then
3069 begin
3070 if(fdiagnoses.count <= 0) then
3071 Include(Result, ndDiag);
3072 if((fprocedures.count <= 0) and (fVisitType.Code = '')) then
3073 begin
3074 TmpLst := TStringList.Create;
3075 try
3076 GetHasCPTList(TmpLst);
3077 if(not DataHasCPTCodes(TmpLst)) then
3078 Include(Result, ndProc);
3079 finally
3080 TmpLst.Free;
3081 end;
3082 end;
3083 if(RequireExposures(FNoteIEN, FNoteTitle)) then
3084 begin
3085 NeedSC := FALSE;
3086 EC := EligbleConditions;
3087 if (EC.SCAllow and (SCRelated = SCC_NA)) then
3088 NeedSC := TRUE
3089 else if(SCRelated <> SCC_YES) then //if screlated = yes, the others are not asked.
3090 begin
3091 if(EC.AOAllow and (AORelated = SCC_NA)) then NeedSC := TRUE
3092 else if(EC.IRAllow and (IRRelated = SCC_NA)) then NeedSC := TRUE
3093 else if(EC.ECAllow and (ECRelated = SCC_NA)) then NeedSC := TRUE
3094 end;
3095 if(EC.MSTAllow and (MSTRelated = SCC_NA)) then NeedSC := TRUE;
3096// if HNCOK and (EC.HNCAllow and (HNCRelated = SCC_NA)) then NeedSC := TRUE;
3097 if(EC.HNCAllow and (HNCRelated = SCC_NA)) then NeedSC := TRUE;
3098 if(EC.CVAllow and (CVRelated = SCC_NA)) then NeedSC := TRUE;
3099 if(NeedSC) then
3100 Include(Result, ndSC);
3101 end;
3102(* if(Result = []) and (FNoteIEN > 0) then // **** block removed in v19.1 {RV} ****
3103 ClearCPTRequired(FNoteIEN);*)
3104 end;
3105 end;
3106end;
3107
3108
3109function TPCEData.OK2SignNote: boolean;
3110var
3111 Req: tRequiredPCEDataTypes;
3112 msg: string;
3113 Asked, DoAsk, Primary, Needed: boolean;
3114 Outpatient, First, DoSave, NeedSave, Done: boolean;
3115 Ans: integer;
3116 Flags: word;
3117 Ask: TAskPCE;
3118
3119 procedure Add(Typ: tRequiredPCEDataType; txt: string);
3120 begin
3121 if(Typ in Req) then
3122 msg := msg + txt + CRLF;
3123 end;
3124
3125begin
3126 if not CanEditPCE(Self) then
3127 begin
3128 Result := TRUE;
3129 exit;
3130 end;
3131 if IsNonCountClinic(FEncLocation) then
3132 begin
3133 Result := TRUE;
3134 exit;
3135 end;
3136 if IsCancelOrNoShow(NoteIEN) then
3137 begin
3138 Result := TRUE;
3139 exit;
3140 end;
3141 Ask := GetAskPCE(FEncLocation);
3142 if(Ask = apNever) or (Ask = apDisable) then
3143 Result := TRUE
3144 else
3145 begin
3146 DoSave := FALSE;
3147 try
3148 Asked := FALSE;
3149 First := TRUE;
3150 Outpatient := ((FEncSvcCat = 'A') or (FEncSvcCat = 'I') or (FEncSvcCat = 'T'));
3151 repeat
3152 Result := TRUE;
3153 Done := TRUE;
3154 Req := NeededPCEData;
3155 Needed := (Req <> []);
3156 if(First) then
3157 begin
3158 if Needed and (not Outpatient) then
3159 OutPatient := TRUE;
3160 if((Ask = apPrimaryAlways) or Needed or
3161 ((Ask = apPrimaryOutpatient) and Outpatient)) then
3162 begin
3163 if(Providers.PrimaryIdx < 0) then
3164 begin
3165 NoPrimaryPCEProvider(FProviders, Self);
3166 if(not DoSave) then
3167 DoSave := (Providers.PrimaryIdx >= 0);
3168 if(DoSave and (FProviders.PendingIEN(FALSE) <> 0) and
3169 (FProviders.IndexOfProvider(IntToStr(FProviders.PendingIEN(FALSE))) < 0)) then
3170 FProviders.AddProvider(IntToStr(FProviders.PendingIEN(FALSE)), FProviders.PendingName(FALSE), FALSE);
3171 end;
3172 end;
3173 First := FALSE;
3174 end;
3175 Primary := (Providers.PrimaryIEN = User.DUZ);
3176 case Ask of
3177 apPrimaryOutpatient: DoAsk := (Primary and Outpatient);
3178 apPrimaryAlways: DoAsk := Primary;
3179 apNeeded: DoAsk := Needed;
3180 apOutpatient: DoAsk := Outpatient;
3181 apAlways: DoAsk := TRUE;
3182 else
3183 { apPrimaryNeeded } DoAsk := (Primary and Needed);
3184 end;
3185 if(DoAsk) then
3186 begin
3187 if(Asked and ((not Needed) or (not Primary))) then
3188 exit;
3189 if(Needed) then
3190 begin
3191 msg := TX_NEED1;
3192 Add(ndDiag, TX_NEED_DIAG);
3193 Add(ndProc, TX_NEED_PROC);
3194 Add(ndSC, TX_NEED_SC);
3195 if(Primary and ForcePCEEntry(FEncLocation)) then
3196 begin
3197 Flags := MB_OKCANCEL;
3198 msg := msg + CRLF + TX_NEED3;
3199 end
3200 else
3201 begin
3202 if(Primary) then
3203 Flags := MB_YESNOCANCEL
3204 else
3205 Flags := MB_YESNO;
3206 msg := msg + CRLF + TX_NEED2;
3207 end;
3208 Flags := Flags + MB_ICONWARNING;
3209 end
3210 else
3211 begin
3212 Flags := MB_YESNO + MB_ICONQUESTION;
3213 msg := TX_NEED2;
3214 end;
3215 Ans := InfoBox(msg, TX_NEED_T, Flags);
3216 if(Ans = ID_CANCEL) then
3217 begin
3218 Result := FALSE;
3219 InfoBox(TX_NEEDABORT, TX_NEED_T, MB_OK);
3220 exit;
3221 end;
3222 Result := (Ans = ID_NO);
3223 if(not Result) then
3224 begin
3225 if(not MissingProviderInfo(Self)) then
3226 begin
3227 NeedSave := UpdatePCE(Self, FALSE);
3228 if(not DoSave) then
3229 DoSave := NeedSave;
3230 FUpdated := TRUE;
3231 end;
3232 Done := frmFrame.Closing;
3233 Asked := TRUE;
3234 end;
3235 end;
3236 until(Done);
3237 finally
3238 if(DoSave) then
3239 Save;
3240 end;
3241 end;
3242end;
3243
3244procedure TPCEData.AddStrData(List: TStrings);
3245
3246 procedure Add(Txt: string);
3247 begin
3248 if(length(Txt) > 0) then List.Add(Txt);
3249 end;
3250
3251begin
3252 Add(StrVisitType);
3253 Add(StrDiagnoses);
3254 Add(StrProcedures);
3255 Add(StrImmunizations);
3256 Add(StrSkinTests);
3257 Add(StrPatientEds);
3258 Add(StrHealthFactors);
3259 Add(StrExams);
3260end;
3261
3262procedure TPCEData.AddVitalData(Data, List: TStrings);
3263var
3264 i: integer;
3265
3266begin
3267 for i := 0 to Data.Count-1 do
3268 List.Add(FormatVitalForNote(Data[i]));
3269end;
3270
3271function TPCEData.PersonClassDate: TFMDateTime;
3272begin
3273 if(FEncSvcCat = 'H') then
3274 Result := FMToday
3275 else
3276 Result := FEncDateTime; //Encounter.DateTime;
3277end;
3278
3279function TPCEData.VisitDateTime: TFMDateTime;
3280begin
3281 if(IsSecondaryVisit) then
3282 Result := FNoteDateTime
3283 else
3284 Result := FEncDateTime;
3285end;
3286
3287function TPCEData.IsSecondaryVisit: boolean;
3288begin
3289 Result := ((FEncSvcCat = 'H') and (FNoteDateTime > 0) and (FEncInpatient));
3290end;
3291
3292function TPCEData.NeedProviderInfo: boolean;
3293var
3294 i: integer;
3295 TmpLst: TStringList;
3296
3297begin
3298 if(FProviders.PrimaryIdx < 0) then
3299 begin
3300 Result := AutoCheckout(FEncLocation);
3301 if not Result then
3302 begin
3303 for i := 0 to FDiagnoses.Count - 1 do
3304 begin
3305 if not TPCEDiag(FDiagnoses[i]).FDelete then
3306 begin
3307 Result := TRUE;
3308 break;
3309 end;
3310 end;
3311 end;
3312 if not Result then
3313 begin
3314 for i := 0 to FProcedures.Count - 1 do
3315 begin
3316 if not TPCEProc(FProcedures[i]).FDelete then
3317 begin
3318 Result := TRUE;
3319 break;
3320 end;
3321 end;
3322 end;
3323 if not Result then
3324 begin
3325 for i := 0 to FProviders.Count - 1 do
3326 begin
3327 if not FProviders[i].Delete then
3328 begin
3329 Result := TRUE;
3330 break;
3331 end;
3332 end;
3333 end;
3334 if not Result then
3335 begin
3336 TmpLst := TStringList.Create;
3337 try
3338 GetHasCPTList(TmpLst);
3339 if(DataHasCPTCodes(TmpLst)) then
3340 Result := TRUE;
3341 finally
3342 TmpLst.Free;
3343 end;
3344 end;
3345 end
3346 else
3347 Result := FALSE;
3348end;
3349
3350procedure TPCEData.GetHasCPTList(AList: TStrings);
3351
3352 procedure AddList(List: TList);
3353 var
3354 i: integer;
3355 tmp: string;
3356
3357 begin
3358 for i := 0 to List.Count-1 do
3359 begin
3360 tmp := TPCEItem(List[i]).HasCPTStr;
3361 if(tmp <> '') then
3362 AList.Add(tmp);
3363 end;
3364 end;
3365
3366begin
3367 AddList(FImmunizations);
3368 AddList(FSkinTests);
3369 AddList(FPatientEds);
3370 AddList(FHealthFactors);
3371 AddList(FExams);
3372end;
3373
3374procedure TPCEData.CopyPCEItems(Src: TList; Dest: TObject; ItemClass: TPCEItemClass);
3375var
3376 AItem: TPCEItem;
3377 i: Integer;
3378 IsStrings: boolean;
3379
3380begin
3381 if(Dest is TStrings) then
3382 IsStrings := TRUE
3383 else
3384 if(Dest is TList) then
3385 IsStrings := FALSE
3386 else
3387 exit;
3388 for i := 0 to Src.Count - 1 do
3389 begin
3390 if(not TPCEItem(Src[i]).FDelete) then
3391 begin
3392 AItem := ItemClass.Create;
3393 AItem.Assign(TPCEItem(Src[i]));
3394 if(IsStrings) then
3395 TStrings(Dest).AddObject(AItem.ItemStr, AItem)
3396 else
3397 TList(Dest).Add(AItem);
3398 end;
3399 end;
3400end;
3401
3402function TPCEData.Empty: boolean;
3403begin
3404 Result := (FProviders.Count = 0);
3405 if(Result) then Result := (FSCRelated = SCC_NA);
3406 if(Result) then Result := (FAORelated = SCC_NA);
3407 if(Result) then Result := (FIRRelated = SCC_NA);
3408 if(Result) then Result := (FECRelated = SCC_NA);
3409 if(Result) then Result := (FMSTRelated = SCC_NA);
3410// if(Result) and HNCOK then Result := (FHNCRelated = SCC_NA);
3411 if(Result) then Result := (FHNCRelated = SCC_NA);
3412 if(Result) then Result := (FCVRelated = SCC_NA);
3413 if(Result) then Result := (FDiagnoses.Count = 0);
3414 if(Result) then Result := (FProcedures.Count = 0);
3415 if(Result) then Result := (FImmunizations.Count = 0);
3416 if(Result) then Result := (FSkinTests.Count = 0);
3417 if(Result) then Result := (FPatientEds.Count = 0);
3418 if(Result) then Result := (FHealthFactors.Count = 0);
3419 if(Result) then Result := (fExams.Count = 0);
3420 if(Result) then Result := (FVisitType.Empty);
3421end;
3422
3423{ TPCEProviderList }
3424
3425function TPCEProviderList.Add(const S: string): Integer;
3426var
3427 SIEN: string;
3428 LastPrimary: integer;
3429
3430begin
3431 SIEN := IntToStr(StrToInt64Def(Piece(S, U, pnumPrvdrIEN), 0));
3432 if(SIEN = '0') then
3433 Result := -1
3434 else
3435 begin
3436 LastPrimary := PrimaryIdx;
3437 Result := IndexOfProvider(SIEN);
3438 if(Result < 0) then
3439 Result := inherited Add(S)
3440 else
3441 Strings[Result] := S;
3442 if(Piece(S, U, pnumPrvdrPrimary) = '1') then
3443 begin
3444 FNoUpdate := TRUE;
3445 try
3446 SetPrimaryIdx(Result);
3447 finally
3448 FNoUpdate := FALSE;
3449 end;
3450 if(assigned(FOnPrimaryChanged) and (LastPrimary <> PrimaryIdx)) then
3451 FOnPrimaryChanged(Self);
3452 end;
3453 end;
3454end;
3455
3456function TPCEProviderList.AddProvider(AIEN, AName: string; APrimary: boolean): integer;
3457var
3458 tmp: string;
3459
3460begin
3461 tmp := 'PRV' + U + AIEN + U + U + U + AName + U;
3462 if(APrimary) then tmp := tmp + '1';
3463 Result := Add(tmp);
3464end;
3465
3466procedure TPCEProviderList.Clear;
3467var
3468 DoNotify: boolean;
3469
3470begin
3471 DoNotify := (assigned(FOnPrimaryChanged) and (GetPrimaryIdx >= 0));
3472 FPendingDefault := '';
3473 FPendingUser := '';
3474 FPCEProviderIEN := 0;
3475 FPCEProviderName := '';
3476 inherited;
3477 if(DoNotify) then
3478 FOnPrimaryChanged(Self);
3479end;
3480
3481procedure TPCEProviderList.Delete(Index: Integer);
3482var
3483 DoNotify: boolean;
3484
3485begin
3486 DoNotify := (assigned(FOnPrimaryChanged) and (Piece(Strings[Index], U, pnumPrvdrPrimary) = '1'));
3487 inherited Delete(Index);
3488 if(DoNotify) then
3489 FOnPrimaryChanged(Self);
3490end;
3491
3492function TPCEProviderList.PCEProvider: Int64;
3493
3494 function Check(AIEN: Int64): Int64;
3495 begin
3496 if(AIEN = 0) or (IndexOfProvider(IntToStr(AIEN)) < 0) then
3497 Result := 0
3498 else
3499 Result := AIEN;
3500 end;
3501
3502begin
3503 Result := Check(Encounter.Provider);
3504 if(Result = 0) then Result := Check(User.DUZ);
3505 if(Result = 0) then Result := PrimaryIEN;
3506end;
3507
3508function TPCEProviderList.PCEProviderName: string;
3509var
3510 NewProv: Int64;
3511
3512begin
3513 NewProv := PCEProvider;
3514 if(FPCEProviderIEN <> NewProv) then
3515 begin
3516 FPCEProviderIEN := NewProv;
3517 FPCEProviderName := ExternalName(PCEProvider, FN_NEW_PERSON);
3518 end;
3519 Result := FPCEProviderName;
3520end;
3521
3522function TPCEProviderList.GetPrimaryIdx: integer;
3523begin
3524 Result := IndexOfPiece('1', U, pnumPrvdrPrimary);
3525end;
3526
3527function TPCEProviderList.GetProviderData(Index: integer): TPCEProviderRec;
3528var
3529 X: string;
3530
3531begin
3532 X := Strings[Index];
3533 Result.IEN := StrToInt64Def(Piece(X, U, pnumPrvdrIEN), 0);
3534 Result.Name := Piece(X, U, pnumPrvdrName);
3535 Result.Primary := (Piece(X, U, pnumPrvdrPrimary) = '1');
3536 Result.Delete := (Piece(X, U, 1) = 'PRV-');
3537end;
3538
3539function TPCEProviderList.IndexOfProvider(AIEN: string): integer;
3540begin
3541 Result := IndexOfPiece(AIEN, U, pnumPrvdrIEN);
3542end;
3543
3544procedure TPCEProviderList.Merge(AList: TPCEProviderList);
3545var
3546 i, idx: integer;
3547 tmp: string;
3548
3549begin
3550 for i := 0 to Count-1 do
3551 begin
3552 tmp := Strings[i];
3553 idx := AList.IndexOfProvider(Piece(tmp, U, pnumPrvdrIEN));
3554 if(idx < 0) then
3555 begin
3556 SetPiece(tmp, U, 1, 'PRV-');
3557 Strings[i] := tmp;
3558 end;
3559 end;
3560 for i := 0 to AList.Count-1 do
3561 Add(AList.Strings[i]); // Add already filters out duplicates
3562end;
3563
3564function TPCEProviderList.PendingIEN(ADefault: boolean): Int64;
3565begin
3566 if(ADefault) then
3567 Result := StrToInt64Def(Piece(FPendingDefault, U, 1), 0)
3568 else
3569 Result := StrToInt64Def(Piece(FPendingUser, U, 1), 0);
3570end;
3571
3572function TPCEProviderList.PendingName(ADefault: boolean): string;
3573begin
3574 if(ADefault) then
3575 Result := Piece(FPendingDefault, U, 2)
3576 else
3577 Result := Piece(FPendingUser, U, 2);
3578end;
3579
3580function TPCEProviderList.PrimaryIEN: int64;
3581var
3582 idx: integer;
3583
3584begin
3585 idx := GetPrimaryIdx;
3586 if(idx < 0) then
3587 Result := 0
3588 else
3589 Result := StrToInt64Def(Piece(Strings[idx], U, pnumPrvdrIEN), 0);
3590end;
3591
3592function TPCEProviderList.PrimaryName: string;
3593var
3594 idx: integer;
3595
3596begin
3597 idx := GetPrimaryIdx;
3598 if(idx < 0) then
3599 Result := ''
3600 else
3601 Result := Piece(Strings[idx], U, pnumPrvdrName);
3602end;
3603
3604procedure TPCEProviderList.SetPrimary(index: integer; Primary: boolean);
3605var
3606 tmp, x: string;
3607
3608begin
3609 tmp := Strings[index];
3610 if(Primary) then
3611 x := '1'
3612 else
3613 x := '';
3614 SetPiece(tmp, U, pnumPrvdrPrimary, x);
3615 Strings[Index] := tmp;
3616end;
3617
3618procedure TPCEProviderList.SetPrimaryIdx(const Value: integer);
3619var
3620 LastPrimary, idx: integer;
3621 Found: boolean;
3622
3623begin
3624 LastPrimary := GetPrimaryIdx;
3625 idx := -1;
3626 Found := FALSE;
3627 repeat
3628 idx := IndexOfPiece('1', U, pnumPrvdrPrimary, idx);
3629 if(idx >= 0) then
3630 begin
3631 if(idx = Value) then
3632 Found := TRUE
3633 else
3634 SetPrimary(idx, FALSE);
3635 end;
3636 until(idx < 0);
3637 if(not Found) and (Value >= 0) and (Value < Count) then
3638 SetPrimary(Value, TRUE);
3639 if((not FNoUpdate) and assigned(FOnPrimaryChanged) and (LastPrimary <> Value)) then
3640 FOnPrimaryChanged(Self);
3641end;
3642
3643procedure TPCEProviderList.SetProviderData(Index: integer;
3644 const Value: TPCEProviderRec);
3645var
3646 tmp, SIEN: string;
3647
3648begin
3649 if(Value.IEN = 0) or (index < 0) or (index >= Count) then exit;
3650 SIEN := IntToStr(Value.IEN);
3651 if(IndexOfPiece(SIEN, U, pnumPrvdrIEN) = index) then
3652 begin
3653 tmp := 'PRV';
3654 if(Value.Delete) then tmp := tmp + '-';
3655 tmp := tmp + U + SIEN + U + U + U + Value.Name + U;
3656 Strings[index] := tmp;
3657 if Value.Primary then
3658 SetPrimaryIdx(Index);
3659 end;
3660end;
3661
3662procedure TPCEProviderList.Assign(Source: TPersistent);
3663var
3664 Src: TPCEProviderList;
3665
3666begin
3667 inherited Assign(Source);
3668 if(Source is TPCEProviderList) then
3669 begin
3670 Src := TPCEProviderList(Source);
3671 Src.FOnPrimaryChanged := FOnPrimaryChanged;
3672 Src.FPendingDefault := FPendingDefault;
3673 Src.FPendingUser := FPendingUser;
3674 Src.FPCEProviderIEN := FPCEProviderIEN;
3675 Src.FPCEProviderName := FPCEProviderName;
3676 end;
3677end;
3678
3679initialization
3680
3681finalization
3682 KillObj(@PCESetsOfCodes);
3683 KillObj(@HistLocations);
3684
3685end.
Note: See TracBrowser for help on using the repository browser.