source: cprs/trunk/CPRS-Chart/Encounter/uPCE.pas@ 924

Last change on this file since 924 was 829, checked in by Kevin Toppenberg, 14 years ago

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