source: cprs/branches/tmg-cprs/CPRS-Chart/Encounter/rPCE.pas@ 1085

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

Initial upload of TMG-CPRS 1.0.26.69
File size: 46.6 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit rPCE;
3
4{$OPTIMIZATION OFF} // REMOVE AFTER UNIT IS DEBUGGED
5
6interface
7
8uses SysUtils, Classes, ORNet, ORFn, uPCE, UBACore, ORClasses;
9
10const
11 LX_ICD = 12;
12 LX_CPT = 13;
13
14 LX_Threshold = 15;
15
16 PCE_IMM = 20;
17 PCE_SK = 21;
18 PCE_PED = 22;
19 PCE_HF = 23;
20 PCE_XAM = 24;
21 PCE_TRT = 25;
22
23 SCC_YES = 1;
24 SCC_NO = 0;
25 SCC_NA = -1;
26
27var
28 uEncLocation: integer;
29// uEncDateTime: TFMDateTime;
30
31type
32 TSCConditions = record
33 SCAllow: Boolean; // prompt for service connected
34 SCDflt: Boolean; // default if prompting service connected
35 AOAllow: Boolean; // prompt for agent orange exposure
36 AODflt: Boolean; // default if prompting agent orange exposure
37 IRAllow: Boolean; // prompt for ionizing radiation exposure
38 IRDflt: Boolean; // default if prompting ionizing radiation
39 ECAllow: Boolean; // prompt for environmental conditions
40 ECDflt: Boolean; // default if prompting environmental cond.
41 MSTAllow: Boolean; // prompt for military sexual trauma
42 MSTDflt: Boolean; // default if prompting military sexual trauma
43 HNCAllow: Boolean; // prompt for Head or Neck Cancer
44 HNCDflt: Boolean; // default if prompting Head or Neck Cancer
45 CVAllow: Boolean; // prompt for Combat Veteran Related
46 CVDflt: Boolean; // default if prompting Comabt Veteran
47 end;
48
49 TPCEListCodesProc = procedure(Dest: TStrings; SectionIndex: Integer);
50
51 TAskPCE = (apPrimaryNeeded, apPrimaryOutpatient, apPrimaryAlways,
52 apNeeded, apOutpatient, apAlways, apNever, apDisable);
53
54function GetVisitCat(InitialCat: char; Location: integer; Inpatient: boolean): char;
55
56{assign and read values from fPCEData}
57//function SetRPCEncouterInfo(PCEData: TPCEData): boolean;
58function SetRPCEncLocation(Loc: Integer): boolean;
59//function SetRPCEncDateTime(DT: TFMDateTime): boolean;
60
61function PCERPCEncLocation: integer;
62//function PCERPCEncDateTime: TFMDateTime;
63function GetLocSecondaryVisitCode(Loc: integer): char;
64
65{check for active person class on provider}
66function CheckActivePerson(provider:string;DateTime:TFMDateTime): boolean;
67function ForcePCEEntry(Loc: integer): boolean;
68
69{"Other" form PCE calls}
70procedure LoadcboOther(Dest: TStrings; Location, fOtherApp: Integer);
71
72{ Lexicon Lookup Calls }
73function LexiconToCode(IEN, LexApp: Integer; ADate: TFMDateTime = 0): string;
74procedure ListLexicon(Dest: TStrings; const x: string; LexApp: Integer; ADate: TFMDateTime = 0);
75function IsActiveICDCode(ACode: string; ADate: TFMDateTime = 0): boolean;
76function IsActiveCPTCode(ACode: string; ADate: TFMDateTime = 0): boolean;
77function IsActiveCode(ACode: string; LexApp: integer; ADate: TFMDateTime = 0): boolean;
78
79{ Encounter Form Elements }
80procedure DeletePCE(const AVisitStr: string);
81function EligbleConditions: TSCConditions;
82
83procedure ListVisitTypeSections(Dest: TStrings);
84procedure ListVisitTypeCodes(Dest: TStrings; SectionIndex: Integer);
85procedure ListVisitTypeByLoc(Dest: TStrings; Location: Integer; ADateTime: TFMDateTime = 0);
86function AutoSelectVisit(Location: integer): boolean;
87function UpdateVisitTypeModifierList(Dest: TStrings; Index: integer): string;
88
89procedure ListDiagnosisSections(Dest: TStrings);
90procedure ListDiagnosisCodes(Dest: TStrings; SectionIndex: Integer);
91
92procedure ListExamsSections(Dest: TStrings);
93procedure ListExamsCodes(Dest: TStrings; SectionIndex: Integer);
94
95procedure ListHealthSections(Dest: TStrings);
96procedure ListHealthCodes(Dest: TStrings; SectionIndex: Integer);
97
98procedure ListImmunizSections(Dest: TStrings);
99procedure ListImmunizCodes(Dest: TStrings; SectionIndex: Integer);
100
101procedure ListPatientSections(Dest: TStrings);
102procedure ListPatientCodes(Dest: TStrings; SectionIndex: Integer);
103
104procedure ListProcedureSections(Dest: TStrings);
105procedure ListProcedureCodes(Dest: TStrings; SectionIndex: Integer);
106function ModifierList(CPTCode: string): string;
107procedure ListCPTModifiers(Dest: TStrings; CPTCodes, NeededModifiers: string);
108function ModifierName(ModIEN: string): string;
109function ModifierCode(ModIEN: string): string;
110function UpdateModifierList(Dest: TStrings; Index: integer): string;
111
112procedure ListSkinSections(Dest: TStrings);
113procedure ListSkinCodes(Dest: TStrings; SectionIndex: Integer);
114
115procedure ListSCDisabilities(Dest: TStrings);
116procedure LoadPCEDataForNote(Dest: TStrings; ANoteIEN: Integer; VStr: string);
117function GetVisitIEN(NoteIEN: Integer): string;
118procedure SavePCEData(PCEList: TStringList; ANoteIEN, ALocation: integer);
119
120function DataHasCPTCodes(AList: TStrings): boolean;
121function GetAskPCE(Loc: integer): TAskPCE;
122function HasVisit(const ANoteIEN, ALocation: integer; const AVisitDate: TFMDateTime): Integer;
123
124procedure LoadImmSeriesItems(Dest: TStrings);
125procedure LoadImmReactionItems(Dest: TStrings);
126procedure LoadSkResultsItems(Dest: TStrings);
127procedure LoadPEDLevelItems(Dest: TStrings);
128procedure LoadHFLevelItems(Dest: TStrings);
129procedure LoadXAMResultsItems(Dest: TStrings);
130procedure LoadHistLocations(Dest: TStrings);
131procedure AddProbsToDiagnoses;
132
133//GAF
134function GAFOK: boolean;
135function MHClinic(const Location: integer): boolean;
136procedure RecentGAFScores(const Limit: integer);
137function SaveGAFScore(const Score: integer; GAFDate: TFMDateTime; Staff: Int64): boolean;
138function GAFURL: string;
139function MHTestsOK: boolean;
140function MHTestAuthorized(Test: string): boolean;
141
142function AnytimeEncounters: boolean;
143function AutoCheckout(Loc: integer): boolean;
144
145{ Encounter }
146//function RequireExposures(ANote: Integer): Boolean; {RAB}
147function RequireExposures(ANote, ATitle: Integer): Boolean;
148function PromptForWorkload(ANote, ATitle: Integer; VisitCat: Char; StandAlone: boolean): Boolean;
149function DefaultProvider(ALocation: integer; AUser: Int64; ADate: TFMDateTime;
150 ANoteIEN: integer): string;
151function IsUserAProvider(AUser: Int64; ADate: TFMDateTime): boolean;
152function IsCancelOrNoShow(ANote: integer): boolean;
153function IsNonCountClinic(ALocation: integer): boolean;
154
155// HNC Flag
156//function HNCOK: boolean;
157
158implementation
159
160uses TRPCB, rCore, uCore, uConst, fEncounterFrame, UBAGlobals, UBAConst
161 ,DKLang //kt
162 ;
163
164var
165 uLastLocation: Integer;
166 uLastDFN: String;
167 uVTypeLastLoc: Integer;
168 uVTypeLastDate: double = 0;
169 uDiagnoses: TStringList;
170 uExams: TStringList;
171 uHealthFactors: TStringList;
172 uImmunizations: TStringList;
173 uPatientEds: TStringList;
174 uProcedures: TStringList;
175 uSkinTests: TStringList;
176 uVisitTypes: TStringList;
177 uVTypeForLoc: TStringList;
178 uProblems: TStringList;
179 uModifiers: TORStringList = nil;
180 uGAFOK: boolean;
181 uGAFOKCalled: boolean = FALSE;
182 uLastForceLoc: integer = -1;
183 uLastForce: boolean;
184 uHasCPT: TStringList = nil;
185 uGAFURL: string;
186 uGAFURLChecked: boolean = FALSE;
187 uMHOK: boolean;
188 uMHOKChecked: boolean = FALSE;
189 uVCInitialCat: char = #0;
190 uVCLocation: integer = -2;
191 uVCInpatient: boolean = FALSE;
192 uVCResult: char;
193 uAPUser: Int64 = -1;
194 uAPLoc: integer = -2;
195 uAPAsk: TAskPCE;
196 uAnytimeEnc: integer = -1;
197 UAutoSelLoc: integer = -1;
198 UAutoSelVal: boolean;
199 uLastChkOut: boolean;
200 uLastChkOutLoc: integer = -2;
201 uLastIsClinicLoc: integer = 0;
202 uLastIsClinic: boolean = FALSE;
203// uHNCOK: integer = -1;
204
205function GetVisitCat(InitialCat: char; Location: integer; Inpatient: boolean): char;
206var
207 tmp: string;
208
209begin
210 if(InitialCat <> uVCInitialCat) or (Location <> uVCLocation) or
211 (Inpatient <> uVCInpatient) then
212 begin
213 uVCInitialCat := InitialCat;
214 uVCLocation := Location;
215 uVCInpatient := Inpatient;
216 tmp := sCallV('ORWPCE GETSVC', [InitialCat, Location, BOOLCHAR[Inpatient]]);
217 if(tmp <> '') then
218 uVCResult := tmp[1]
219 else
220 uVCResult := InitialCat;
221 end;
222 Result := uVCResult
223end;
224
225{ Lexicon Lookup Calls }
226
227function LexiconToCode(IEN, LexApp: Integer; ADate: TFMDateTime = 0): string;
228var
229 CodeSys: string;
230begin
231 case LexApp of
232 LX_ICD: CodeSys := 'ICD';
233 LX_CPT: CodeSys := 'CHP';
234 end;
235 Result := sCallV('ORWPCE LEXCODE', [IEN, CodeSys, ADate]);
236end;
237
238procedure ListLexicon(Dest: TStrings; const x: string; LexApp: Integer; ADate: TFMDateTime = 0);
239var
240 CodeSys: string;
241begin
242 case LexApp of
243 LX_ICD: CodeSys := 'ICD';
244 LX_CPT: CodeSys := 'CHP';
245 end;
246 CallV('ORWPCE LEX', [x, CodeSys, ADate]);
247 Dest.Assign(RPCBrokerV.Results);
248end;
249
250function IsActiveICDCode(ACode: string; ADate: TFMDateTime = 0): boolean;
251begin
252 Result := IsActiveCode(ACode, LX_ICD, ADate);
253end;
254
255function IsActiveCPTCode(ACode: string; ADate: TFMDateTime = 0): boolean;
256begin
257 Result := IsActiveCode(ACode, LX_CPT, ADate);
258end;
259
260function IsActiveCode(ACode: string; LexApp: integer; ADate: TFMDateTime = 0): boolean;
261var
262 CodeSys: string;
263begin
264 case LexApp of
265 LX_ICD: CodeSys := 'ICD';
266 LX_CPT: CodeSys := 'CHP';
267 end;
268 Result := (sCallV('ORWPCE ACTIVE CODE',[ACode, CodeSys, ADate]) = '1');
269end;
270
271{ Encounter Form Elements ------------------------------------------------------------------ }
272
273procedure DeletePCE(const AVisitStr: string);
274begin
275 sCallV('ORWPCE DELETE', [AVisitStr, Patient.DFN]);
276end;
277
278procedure LoadEncounterForm;
279{ load the major coding lists that are used by the encounter form for a given location }
280var
281 i: integer;
282 uTempList: TStringList;
283 EncDt: TFMDateTime;
284
285begin
286 uLastLocation := uEncLocation;
287 EncDt := Trunc(uEncPCEData.VisitDateTime);
288
289 //add problems to the top of diagnoses.
290 uTempList := TstringList.Create;
291
292
293 if UBAGlobals.BILLING_AWARE then //BAPHII 1.3.10
294 begin
295 UBACore.BADxList := TStringList.Create;
296 end;
297
298 try
299 uDiagnoses.clear;
300
301 if BILLING_AWARE then
302 begin
303 UBACore.BADxList.Clear; //BAPHII 1.3.10
304 end;
305
306 tCallV(uTempList, 'ORWPCE DIAG', [uEncLocation, EncDt]); //BAPHII 1.3.10
307 uDiagnoses.add(utemplist.strings[0]); //BAPHII 1.3.10
308 AddProbsToDiagnoses; //BAPHII 1.3.10
309 // BA 25 AddProviderPatientDaysDx(uDxLst, IntToStr(Encounter.Provider), Patient.DFN);
310 for i := 1 to (uTempList.Count-1) do //BAPHII 1.3.10
311 uDiagnoses.add(uTemplist.strings[i]); //BAPHII 1.3.10
312
313 finally
314 uTempList.free;
315 end;
316
317 tCallV(uVisitTypes, 'ORWPCE VISIT', [uEncLocation, EncDt]);
318 tCallV(uProcedures, 'ORWPCE PROC', [uEncLocation, EncDt]);
319 tCallV(uImmunizations, 'ORWPCE IMM', [uEncLocation]);
320 tCallV(uSkinTests, 'ORWPCE SK', [uEncLocation]);
321 tCallV(uPatientEds, 'ORWPCE PED', [uEncLocation]);
322 tCallV(uHealthFactors, 'ORWPCE HF', [uEncLocation]);
323 tCallV(uExams, 'ORWPCE XAM', [uEncLocation]);
324
325 if uVisitTypes.Count > 0 then uVisitTypes.Delete(0); // discard counts
326 if uDiagnoses.Count > 0 then uDiagnoses.Delete(0);
327 if uProcedures.Count > 0 then uProcedures.Delete(0);
328 if uImmunizations.Count > 0 then uImmunizations.Delete(0);
329 if uSkinTests.Count > 0 then uSkinTests.Delete(0);
330 if uPatientEds.Count > 0 then uPatientEds.Delete(0);
331 if uHealthFactors.Count > 0 then uHealthFactors.Delete(0);
332 if uExams.Count > 0 then uExams.Delete(0);
333
334 if (uVisitTypes.Count > 0) and (CharAt(uVisitTypes[0], 1) <> U) then uVisitTypes.Insert(0, U);
335 if (uDiagnoses.Count > 0) and (CharAt(uDiagnoses[0], 1) <> U) then uDiagnoses.Insert(0, U);
336 if (uProcedures.Count > 0) and (CharAt(uProcedures[0], 1) <> U) then uProcedures.Insert(0, U);
337 if (uImmunizations.Count > 0) and (CharAt(uImmunizations[0], 1) <> U) then uImmunizations.Insert(0, U);
338 if (uSkinTests.Count > 0) and (CharAt(uSkinTests[0], 1) <> U) then uSkinTests.Insert(0, U);
339 if (uPatientEds.Count > 0) and (CharAt(uPatientEds[0], 1) <> U) then uPatientEds.Insert(0, U);
340 if (uHealthFactors.Count > 0) and (CharAt(uHealthFactors[0], 1) <> U) then uHealthFactors.Insert(0, U);
341 if (uExams.Count > 0) and (CharAt(uExams[0], 1) <> U) then uExams.Insert(0, U);
342
343end;
344
345{Visit Types-------------------------------------------------------------------}
346procedure ListVisitTypeSections(Dest: TStrings);
347{ return section names in format: ListIndex^SectionName (sections begin with '^') }
348var
349 i: Integer;
350 x: string;
351begin
352 if (uLastLocation <> uEncLocation) then LoadEncounterForm;
353 for i := 0 to uVisitTypes.Count - 1 do if CharAt(uVisitTypes[i], 1) = U then
354 begin
355 x := Piece(uVisitTypes[i], U, 2);
356// if Length(x) = 0 then x := '<No Section Name>'; <-- original line. //kt 8/8/2007
357 if Length(x) = 0 then x := DKLangConstW('rPCE_xNo_Section_Namex'); //kt added 8/8/2007
358 Dest.Add(IntToStr(i) + U + Piece(uVisitTypes[i], U, 2) + U + x);
359 end;
360end;
361
362procedure ListVisitTypeCodes(Dest: TStrings; SectionIndex: Integer);
363{ return visit types in format: visit type <TAB> amount of time <TAB> CPT code <TAB> CPT code }
364var
365 i: Integer;
366 s: string;
367
368 function InsertTab(x: string): string;
369 { turn the white space between the name and the number of minutes into a single tab }
370 begin
371 if CharAt(x, 20) = ' '
372 then Result := Trim(Copy(x, 1, 20)) + U + Trim(Copy(x, 21, Length(x)))
373 else Result := Trim(x) + U;
374 end;
375
376begin {ListVisitTypeCodes}
377 Dest.Clear;
378 i := SectionIndex + 1; // first line after the section name
379 while (i < uVisitTypes.Count) and (CharAt(uVisitTypes[i], 1) <> U) do
380 begin
381 s := Pieces(uVisitTypes[i], U, 1, 2) + U + InsertTab(Piece(uVisitTypes[i], U, 2)) + U + Piece(uVisitTypes[i], U, 1) +
382 U + IntToStr(i);
383 Dest.Add(s);
384 Inc(i);
385 end;
386end;
387
388procedure ListVisitTypeByLoc(Dest: TStrings; Location: Integer; ADateTime: TFMDateTime = 0);
389var
390 i: Integer;
391 x, SectionName: string;
392 EncDt: TFMDateTime;
393begin
394 EncDt := Trunc(ADateTime);
395 if (uVTypeLastLoc <> Location) or (uVTypeLastDate <> EncDt) then
396 begin
397 uVTypeForLoc.Clear;
398 if Location = 0 then Exit;
399 SectionName := '';
400 CallV('ORWPCE VISIT', [Location, EncDt]);
401 with RPCBrokerV do for i := 0 to Results.Count - 1 do
402 begin
403 x := Results[i];
404 if CharAt(x, 1) = U
405 then SectionName := Piece(x, U, 2)
406 else uVTypeForLoc.Add(Piece(x, U, 1) + U + SectionName + U + Piece(x, U, 2));
407 end;
408 uVTypeLastLoc := Location;
409 uVTypeLastDate := EncDt;
410 end;
411 Dest.Assign(uVTypeForLoc);
412end;
413
414function AutoSelectVisit(Location: integer): boolean;
415begin
416 if UAutoSelLoc <> Location then
417 begin
418 UAutoSelVal := (sCallV('ORWPCE AUTO VISIT TYPE SELECT', [Location]) = '1');
419 UAutoSelLoc := Location;
420 end;
421 Result := UAutoSelVal;
422end;
423
424{Diagnosis---------------------------------------------------------------------}
425procedure ListDiagnosisSections(Dest: TStrings);
426{ return section names in format: ListIndex^SectionName (sections begin with '^') }
427var
428 i: Integer;
429 x: string;
430begin
431 //// if (uLastLocation <> uEncLocation) then LoadEncounterForm;
432 // if (uLastDFN <> patient.DFN) then LoadEncounterForm;// commented out for CIDC needs.
433 LoadEncounterForm;
434 for i := 0 to uDiagnoses.Count - 1 do if CharAt(uDiagnoses[i], 1) = U then
435 begin
436 x := Piece(uDiagnoses[i], U, 2);
437// if Length(x) = 0 then x := '<No Section Name>'; <-- original line. //kt 8/8/2007
438 if Length(x) = 0 then x := DKLangConstW('rPCE_xNo_Section_Namex'); //kt added 8/8/2007
439 Dest.Add(IntToStr(i) + U + Piece(uDiagnoses[i], U, 2) + U + x);
440 end;
441end;
442
443procedure ListDiagnosisCodes(Dest: TStrings; SectionIndex: Integer);
444{ return diagnoses within section in format:
445 diagnosis <TAB> ICDInteger <TAB> .ICDDecimal <TAB> ICD Code }
446var
447 i: Integer;
448 s,d: string;
449 EncDT: TFMDateTime;
450
451begin
452 EncDT := uEncPCEData.VisitDateTime;
453 Dest.Clear;
454 i := SectionIndex + 1; // first line after the section name
455 while (i < uDiagnoses.Count) and (CharAt(uDiagnoses[i], 1) <> U) do
456 begin
457 s := Piece(uDiagnoses[i], U, 1);
458 d := Piece(s, '.', 2);
459 s := s + U + Piece(uDiagnoses[i], U, 2) + U + Piece(s, '.', 1) + U;
460 if(d <> '') then
461 SetPiece(s, U, 4, '.' + d )
462 else // RV - CSV - need to do this so trailing "#" lines up correctly when no decimals
463 SetPiece(s, U, 4, ' ');
464
465 //filtering out inactive codes.
466 if (Piece(uDiagnoses[i], U, 3) = '#') then
467 begin
468 SetPiece(s, U, 5, '#');
469 Dest.Add(s);
470 end
471 else if ((Piece(uDiagnoses[i], U, 3) = '') or
472 ( StrToFloat(Piece(uDiagnoses[i], U, 3)) > EncDT )) then
473 begin
474 Dest.Add(s);
475 end;
476 Inc(i);
477 end;
478end;
479
480procedure AddProbsToDiagnoses;
481var
482 i: integer; //loop index
483 EncDT: TFMDateTime;
484begin
485 //get problem list
486 EncDT := Trunc(uEncPCEData.VisitDateTime);
487 uLastDFN := patient.DFN;
488 tCallV(uProblems, 'ORWPCE ACTPROB',[Patient.DFN, EncDT]);
489 if uProblems.count > 0 then
490 begin
491 //add category to udiagnoses
492 uDiagnoses.add(U + DX_PROBLEM_LIST_TXT);
493 for i := 1 to (uProblems.count-1) do //start with 1 because strings[0] is
494 //the count of elements.
495 begin
496 //add problems to udiagnosis.
497 if (piece(uproblems.Strings[i],U,3) = '799.9') then continue; // DON'T INCLUDE 799.9 CODES
498
499 if (Piece(uproblems.Strings[i], U, 11) = '#') then
500 uDiagnoses.add(piece(uProblems.Strings[i],U,3) + U + // PL code inactive
501 piece(uProblems.Strings[i],U,2) + U + '#')
502 else if (Piece(uproblems.Strings[i], U, 10) = '') then // no inactive date for code
503 uDiagnoses.add(piece(uProblems.Strings[i],U,3) + U +
504 piece(uProblems.Strings[i],U,2))
505 else if (Trunc(StrToFloat(Piece(uProblems.Strings[i], U, 10))) > EncDT) then // code active as of EncDt
506 uDiagnoses.add(piece(uProblems.Strings[i],U,3) + U +
507 piece(uProblems.Strings[i],U,2))
508 else
509 uDiagnoses.add(piece(uProblems.Strings[i],U,3) + U + // PL code inactive
510 piece(uProblems.Strings[i],U,2) + U + '#');
511 end;
512
513 //1.3.10
514 if BILLING_AWARE then
515 begin
516 // add New Section and dx codes to Encounter Diagnosis Section and Code List.
517 // Diagnoses -> Provider/Patient/24 hrs
518 uDiagnoses.add(UBAConst.ENCOUNTER_TODAYS_DX); //BAPHII 1.3.10
519 //BADxList := AddProviderPatientDaysDx(UBACore.uDxLst, IntToStr(Encounter.Provider), Patient.DFN); //BAPHII 1.3.10
520 rpcGetProviderPatientDaysDx(IntToStr(Encounter.Provider), Patient.DFN); //BAPHII 1.3.10
521
522 for i := 0 to (UBACore.uDxLst.Count-1) do //BAPHII 1.3.10
523 uDiagnoses.add(UBACore.uDxLst[i]); //BAPHII 1.3.10
524 // Code added after presentation.....
525 // Add Personal Diagnoses Section and Codes to Encounter Diagnosis Section and Code List.
526 UBACore.uDxLst.Clear;
527 uDiagnoses.Add(UBAConst.ENCOUNTER_PERSONAL_DX);
528 UBACore.uDxLst := rpcGetPersonalDxList(User.DUZ);
529 for i := 0 to (UBACore.uDxLst.Count -1) do
530 begin
531 uDiagnoses.Add(UBACore.uDxLst.Strings[i]);
532 end;
533 end;
534
535 end;
536end;
537{Immunizations-----------------------------------------------------------------}
538procedure LoadImmReactionItems(Dest: TStrings);
539begin
540 tCallV(Dest,'ORWPCE GET SET OF CODES',['9000010.11','.06','1']);
541end;
542
543procedure LoadImmSeriesItems(Dest: TStrings);
544{loads items into combo box on Immunixation screen}
545begin
546 tCallV(Dest,'ORWPCE GET SET OF CODES',['9000010.11','.04','1']);
547end;
548
549procedure ListImmunizSections(Dest: TStrings);
550{ return section names in format: ListIndex^SectionName (sections begin with '^') }
551var
552 i: Integer;
553 x: string;
554begin
555 if (uLastLocation <> uEncLocation) then LoadEncounterForm;
556 for i := 0 to uImmunizations.Count - 1 do if CharAt(uImmunizations[i], 1) = U then
557 begin
558 x := Piece(uImmunizations[i], U, 2);
559// if Length(x) = 0 then x := '<No Section Name>'; <-- original line. //kt 8/8/2007
560 if Length(x) = 0 then x := DKLangConstW('rPCE_xNo_Section_Namex'); //kt added 8/8/2007
561 Dest.Add(IntToStr(i) + U + Piece(uImmunizations[i], U, 2) + U + x);
562 end;
563end;
564
565procedure ListImmunizCodes(Dest: TStrings; SectionIndex: Integer);
566{ return procedures within section in format: procedure <TAB> CPT code <TAB><TAB> CPT code}
567var
568 i: Integer;
569begin
570 Dest.Clear;
571 i := SectionIndex + 1; // first line after the section name
572 while (i < uImmunizations.Count) and (CharAt(uImmunizations[i], 1) <> U) do
573 begin
574 Dest.Add(Pieces(uImmunizations[i], U, 1, 2));
575 Inc(i);
576 end;
577end;
578
579
580{Procedures--------------------------------------------------------------------}
581procedure ListProcedureSections(Dest: TStrings);
582{ return section names in format: ListIndex^SectionName (sections begin with '^') }
583var
584 i: Integer;
585 x: string;
586begin
587 if (uLastLocation <> uEncLocation) then LoadEncounterForm;
588 for i := 0 to uProcedures.Count - 1 do if CharAt(uProcedures[i], 1) = U then
589 begin
590 x := Piece(uProcedures[i], U, 2);
591// if Length(x) = 0 then x := '<No Section Name>'; <-- original line. //kt 8/8/2007
592 if Length(x) = 0 then x := DKLangConstW('rPCE_xNo_Section_Namex'); //kt added 8/8/2007
593 Dest.Add(IntToStr(i) + U + Piece(uProcedures[i], U, 2) + U + x);
594 end;
595end;
596
597procedure ListProcedureCodes(Dest: TStrings; SectionIndex: Integer);
598{ return procedures within section in format: procedure <TAB> CPT code <TAB><TAB> CPT code}
599//Piece 12 are CPT Modifiers, Piece 13 is a flag indicating conversion of Piece 12 from
600//modifier code to modifier IEN (updated in UpdateModifierList routine)
601var
602 i: Integer;
603begin
604 Dest.Clear;
605 i := SectionIndex + 1; // first line after the section name
606 while (i < uProcedures.Count) and (CharAt(uProcedures[i], 1) <> U) do
607 begin
608 Dest.Add(Pieces(uProcedures[i], U, 1, 2) + U + Piece(uProcedures[i], U, 1) + U +
609 Piece(uProcedures[i], U, 12) + U + Piece(uProcedures[i], U, 13) + U +
610 IntToStr(i));
611 Inc(i);
612 end;
613end;
614
615function MixedCaseModifier(const inStr: string): string;
616begin
617 Result := inStr;
618 SetPiece(Result, U, 2, MixedCase(Trim(Piece(Result, U, 2))));
619end;
620
621function ModifierIdx(ModIEN: string): integer;
622var
623 EncDt: TFMDateTime;
624begin
625 Result := uModifiers.IndexOfPiece(ModIEN);
626 if(Result < 0) then
627 begin
628 if Assigned(uEncPCEData) then // may not exist yet on display of note and PCE data
629 EncDT := Trunc(uEncPCEData.VisitDateTime)
630 else if Encounter.DateTime > 0 then // really need note date/time next, but can't get to it
631 EncDT := Trunc(Encounter.DateTime)
632 else
633 EncDT := FMToday;
634 Result := uModifiers.Add(MixedCaseModifier(sCallV('ORWPCE GETMOD', [ModIEN, EncDt])));
635 end;
636end;
637
638function ModifierList(CPTCode: string): string;
639// uModifiers list contains <@>CPTCode;ModCount;^Mod1Index^Mod2Index^...^ModNIndex
640// or MODIEN^MODDescription^ModCode
641
642const
643 CPTCodeHeader = '<@>';
644
645var
646 i, idx: integer;
647 s, ModIEN: string;
648 EncDt: TFMDateTime;
649begin
650 EncDT := Trunc(uEncPCEData.VisitDateTime);
651 idx := uModifiers.IndexOfPiece(CPTCodeHeader + CPTCode, ';', 1);
652 if(idx < 0) then
653 begin
654 CallV('ORWPCE CPTMODS', [CPTCode, EncDt]);
655 s := CPTCodeHeader + CPTCode + ';' + IntToStr(RPCBrokerV.Results.Count) + ';' + U;
656 for i := 0 to RPCBrokerV.Results.Count - 1 do
657 begin
658 ModIEN := piece(RPCBrokerV.Results[i], U, 1);
659 idx := uModifiers.IndexOfPiece(ModIEN);
660 if(idx < 0) then
661 idx := uModifiers.Add(MixedCaseModifier(RPCBrokerV.Results[i]));
662 s := s + IntToStr(idx) + U;
663 end;
664 idx := uModifiers.Add(s);
665 end;
666 Result := uModifiers[idx];
667end;
668
669procedure ListCPTModifiers(Dest: TStrings; CPTCodes, NeededModifiers: string);
670//CPTCodes expected in the format of code^code^code
671//NeededModifiers in format of ModIEN1;ModIEN2;ModIEN3
672var
673 TmpSL: TStringList;
674 i, j, idx, cnt, found: integer;
675 s, Code: string;
676
677begin
678 if(not assigned(uModifiers)) then uModifiers := TORStringList.Create;
679 if(copy(CPTCodes, length(CPTCodes), 1) <> U) then
680 CPTCodes := CPTCodes + U;
681 if(copy(NeededModifiers, length(NeededModifiers), 1) <> ';') then
682 NeededModifiers := NeededModifiers + ';';
683
684 TmpSL := TStringList.Create;
685 try
686 repeat
687 i := pos(U, CPTCodes);
688 if(i > 0) then
689 begin
690 Code := copy(CPTCodes, 1, i-1);
691 delete(CPTCodes,1,i);
692 if(Code <> '') then
693 TmpSL.Add(ModifierList(Code));
694 i := pos(U, CPTCodes);
695 end;
696 until(i = 0);
697 if(TmpSL.Count = 0) then
698 s := ';0;'
699 else
700 if(TmpSL.Count = 1) then
701 s := TmpSL[0]
702 else
703 begin
704 s := '';
705 found := 0;
706 cnt := StrToIntDef(piece(TmpSL[0], ';', 2), 0);
707 for i := 1 to cnt do
708 begin
709 Code := U + Piece(TmpSL[0], U, i+1);
710 for j := 1 to TmpSL.Count-1 do
711 begin
712 if(pos(Code + U, TmpSL[j]) = 0) then
713 begin
714 Code := '';
715 break;
716 end;
717 end;
718 if(Code <> '') then
719 begin
720 s := s + Code;
721 inc(found);
722 end;
723 end;
724 s := s + U;
725 SetPiece(s , U, 1, ';' + IntToStr(Found) + ';');
726 end;
727 finally
728 TmpSL.Free;
729 end;
730
731 Dest.Clear;
732 cnt := StrToIntDef(piece(s, ';', 2), 0);
733 if(NeededModifiers <> '') then
734 begin
735 found := cnt;
736 repeat
737 i := pos(';',NeededModifiers);
738 if(i > 0) then
739 begin
740 idx := StrToIntDef(copy(NeededModifiers,1,i-1),0);
741 if(idx > 0) then
742 begin
743 Code := IntToStr(ModifierIdx(IntToStr(idx))) + U;
744 if(pos(U+Code, s) = 0) then
745 begin
746 s := s + Code;
747 inc(cnt);
748 end;
749 end;
750 delete(NeededModifiers,1,i);
751 end;
752 until(i = 0);
753 if(found <> cnt) then
754 SetPiece(s , ';', 2, IntToStr(cnt));
755 end;
756 for i := 1 to cnt do
757 begin
758 idx := StrToIntDef(piece(s, U, i + 1), -1);
759 if(idx >= 0) then
760 Dest.Add(uModifiers[idx]);
761 end;
762end;
763
764function ModifierName(ModIEN: string): string;
765begin
766 if(not assigned(uModifiers)) then uModifiers := TORStringList.Create;
767 Result := piece(uModifiers[ModifierIdx(ModIEN)], U, 2);
768end;
769
770function ModifierCode(ModIEN: string): string;
771begin
772 if(not assigned(uModifiers)) then uModifiers := TORStringList.Create;
773 Result := piece(uModifiers[ModifierIdx(ModIEN)], U, 3);
774end;
775
776function UpdateModifierList(Dest: TStrings; Index: integer): string;
777var
778 i, idx, LastIdx: integer;
779 Tmp, OKMods, Code: string;
780 OK: boolean;
781
782begin
783 if(Piece(Dest[Index], U, 5) = '1') then
784 Result := Piece(Dest[Index],U,4)
785 else
786 begin
787 Tmp := Piece(Dest[Index], U, 4);
788 Result := '';
789 OKMods := ModifierList(Piece(Dest[Index], U, 1))+U;
790 i := 1;
791 repeat
792 Code := Piece(Tmp,';',i);
793 if(Code <> '') then
794 begin
795 LastIdx := -1;
796 OK := FALSE;
797 repeat
798 idx := uModifiers.IndexOfPiece(Code, U, 3, LastIdx);
799 if(idx > 0) then
800 begin
801 if(pos(U + IntToStr(idx) + U, OKMods)>0) then
802 begin
803 Result := Result + piece(uModifiers[idx],U,1) + ';';
804 OK := TRUE;
805 end
806 else
807 LastIdx := Idx;
808 end;
809 until(idx < 0) or OK;
810 inc(i);
811 end
812 until(Code = '');
813 Tmp := Dest[Index];
814 SetPiece(Tmp,U,4,Result);
815 SetPiece(Tmp,U,5,'1');
816 Dest[Index] := Tmp;
817 idx := StrToIntDef(piece(Tmp,U,6),-1);
818 if(idx >= 0) then
819 begin
820 Tmp := uProcedures[idx];
821 SetPiece(Tmp,U,12,Result);
822 SetPiece(Tmp,U,13,'1');
823 uProcedures[idx] := Tmp;
824 end;
825 end;
826end;
827
828function UpdateVisitTypeModifierList(Dest: TStrings; Index: integer): string;
829var
830 i, idx, LastIdx: integer;
831 Tmp, OKMods, Code: string;
832 OK: boolean;
833
834begin
835 if(Piece(Dest[Index], U, 7) = '1') then
836 Result := Piece(Dest[Index],U,6)
837 else
838 begin
839 Tmp := Piece(Dest[Index], U, 6);
840 Result := '';
841 OKMods := ModifierList(Piece(Dest[Index], U, 1))+U;
842 i := 1;
843 repeat
844 Code := Piece(Tmp,';',i);
845 if(Code <> '') then
846 begin
847 LastIdx := -1;
848 OK := FALSE;
849 repeat
850 idx := uModifiers.IndexOfPiece(Code, U, 3, LastIdx);
851 if(idx > 0) then
852 begin
853 if(pos(U + IntToStr(idx) + U, OKMods)>0) then
854 begin
855 Result := Result + piece(uModifiers[idx],U,1) + ';';
856 OK := TRUE;
857 end
858 else
859 LastIdx := Idx;
860 end;
861 until(idx < 0) or OK;
862 inc(i);
863 end
864 until(Code = '');
865 Tmp := Dest[Index];
866 SetPiece(Tmp,U,6,Result);
867 SetPiece(Tmp,U,7,'1');
868 Dest[Index] := Tmp;
869 idx := StrToIntDef(piece(Tmp,U,8),-1);
870 if(idx >= 0) then
871 begin
872 Tmp := uProcedures[idx];
873 SetPiece(Tmp,U,12,Result);
874 SetPiece(Tmp,U,13,'1');
875 uProcedures[idx] := Tmp;
876 end;
877 end;
878end;
879
880
881{SkinTests---------------------------------------------------------------------}
882procedure LoadSkResultsItems(Dest: TStrings);
883begin
884 tCallV(Dest,'ORWPCE GET SET OF CODES',['9000010.12','.04','1']);
885end;
886
887procedure ListSkinSections(Dest: TStrings);
888{ return section names in format: ListIndex^SectionName (sections begin with '^') }
889var
890 i: Integer;
891 x: string;
892begin
893 if (uLastLocation <> uEncLocation) then LoadEncounterForm;
894 for i := 0 to uSkinTests.Count - 1 do if CharAt(uSkinTests[i], 1) = U then
895 begin
896 x := Piece(uSkinTests[i], U, 2);
897// if Length(x) = 0 then x := '<No Section Name>'; <-- original line. //kt 8/8/2007
898 if Length(x) = 0 then x := DKLangConstW('rPCE_xNo_Section_Namex'); //kt added 8/8/2007
899 Dest.Add(IntToStr(i) + U + Piece(uSkinTests[i], U, 2) + U + x);
900 end;
901end;
902
903
904procedure ListSkinCodes(Dest: TStrings; SectionIndex: Integer);
905{ return procedures within section in format: procedure <TAB> CPT code <TAB><TAB> CPT code}
906var
907 i: Integer;
908begin
909 Dest.Clear;
910 i := SectionIndex + 1; // first line after the section name
911 while (i < uSkinTests.Count) and (CharAt(uSkinTests[i], 1) <> U) do
912 begin
913 Dest.Add(Pieces(uSkinTests[i], U, 1, 2));
914 Inc(i);
915 end;
916end;
917
918
919{Patient Education-------------------------------------------------------------}
920procedure LoadPEDLevelItems(Dest: TStrings);
921begin
922 tCallV(Dest,'ORWPCE GET SET OF CODES',['9000010.16','.06','1']);
923end;
924
925procedure ListPatientSections(Dest: TStrings);
926{ return Sections in format: ListIndex^SectionName (sections begin with '^') }
927var
928 i: Integer;
929 x: string;
930begin
931 if (uLastLocation <> uEncLocation) then LoadEncounterForm;
932 for i := 0 to uPatientEds.Count - 1 do if CharAt(uPatientEds[i], 1) = U then
933 begin
934 x := Piece(uPatientEds[i], U, 2);
935// if Length(x) = 0 then x := '<No Section Name>'; <-- original line. //kt 8/8/2007
936 if Length(x) = 0 then x := DKLangConstW('rPCE_xNo_Section_Namex'); //kt added 8/8/2007
937 Dest.Add(IntToStr(i) + U + Piece(uPatientEds[i], U, 2) + U + x);
938 end;
939end;
940
941
942procedure ListPatientCodes(Dest: TStrings; SectionIndex: Integer);
943{ return PatientEds within section in format: procedure <TAB> CPT code <TAB><TAB> CPT code}
944var
945 i: Integer;
946begin
947 Dest.Clear;
948 i := SectionIndex + 1; // first line after the section name
949 while (i < uPatientEds.Count) and (CharAt(uPatientEds[i], 1) <> U) do
950 begin
951 Dest.Add(Pieces(uPatientEds[i], U, 1, 2));
952 Inc(i);
953 end;
954end;
955
956
957
958{HealthFactors-------------------------------------------------------------}
959procedure LoadHFLevelItems(Dest: TStrings);
960begin
961 tCallV(Dest,'ORWPCE GET SET OF CODES',['9000010.23','.04','1']);
962end;
963
964procedure ListHealthSections(Dest: TStrings);
965{ return Sections in format: ListIndex^SectionName (sections begin with '^') }
966var
967 i: Integer;
968 x: string;
969begin
970 if (uLastLocation <> uEncLocation) then LoadEncounterForm;
971 for i := 0 to uHealthFactors.Count - 1 do if CharAt(uHealthFactors[i], 1) = U then
972 begin
973 x := Piece(uHealthFactors[i], U, 2);
974// if Length(x) = 0 then x := '<No Section Name>'; <-- original line. //kt 8/8/2007
975 if Length(x) = 0 then x := DKLangConstW('rPCE_xNo_Section_Namex'); //kt added 8/8/2007
976 Dest.Add(IntToStr(i) + U + Piece(uHealthFactors[i], U, 2) + U + x);
977 end;
978end;
979
980
981procedure ListHealthCodes(Dest: TStrings; SectionIndex: Integer);
982{ return PatientEds within section in format: procedure <TAB> CPT code <TAB><TAB> CPT code}
983var
984 i: Integer;
985begin
986 Dest.Clear;
987 i := SectionIndex + 1; // first line after the section name
988 while (i < uHealthFactors.Count) and (CharAt(uHealthFactors[i], 1) <> U) do
989 begin
990 Dest.Add(Pieces(uHealthFactors[i], U, 1, 2));
991 Inc(i);
992 end;
993end;
994
995
996
997{Exams-------------------------------------------------------------------------}
998procedure LoadXAMResultsItems(Dest: TStrings);
999begin
1000 tCallV(Dest,'ORWPCE GET SET OF CODES',['9000010.13','.04','1']);
1001end;
1002
1003procedure LoadHistLocations(Dest: TStrings);
1004var
1005 i, j, tlen: integer;
1006 tmp: string;
1007
1008begin
1009 tCallV(Dest,'ORQQPX GET HIST LOCATIONS',[]);
1010 for i := 0 to (Dest.Count - 1) do
1011 begin
1012 tmp := MixedCase(dest[i]);
1013 j := pos(', ',tmp);
1014 tlen := length(tmp);
1015 if(j > 0) and (j < (tlen - 2)) and (pos(tmp[j+2],UpperCaseLetters) > 0) and
1016 (pos(tmp[j+3],LowerCaseLetters)>0) and ((j = (tlen-3)) or (pos(tmp[j+4],LowerCaseLetters)=0)) then
1017 tmp[j+3] := UpCase(tmp[j+3]);
1018 if(tlen > 1) then
1019 begin
1020 if(pos(tmp[tlen],Digits) > 0) and (pos(tmp[tlen-1],Digits)=0) then
1021 insert(' ',tmp, tlen);
1022 end;
1023 dest[i] := tmp;
1024 end;
1025end;
1026
1027procedure ListExamsSections(Dest: TStrings);
1028{ return Sections in format: ListIndex^SectionName (sections begin with '^') }
1029var
1030 i: Integer;
1031 x: string;
1032begin
1033 if (uLastLocation <> uEncLocation) then LoadEncounterForm;
1034 for i := 0 to uExams.Count - 1 do if CharAt(uExams[i], 1) = U then
1035 begin
1036 x := Piece(uExams[i], U, 2);
1037// if Length(x) = 0 then x := '<No Section Name>'; <-- original line. //kt 8/8/2007
1038 if Length(x) = 0 then x := DKLangConstW('rPCE_xNo_Section_Namex'); //kt added 8/8/2007
1039 Dest.Add(IntToStr(i) + U + Piece(uExams[i], U, 2) + U + x);
1040 end;
1041end;
1042
1043
1044procedure ListExamsCodes(Dest: TStrings; SectionIndex: Integer);
1045{ return PatientEds within section in format: procedure <TAB> CPT code <TAB><TAB> CPT code}
1046var
1047 i: Integer;
1048begin
1049 Dest.Clear;
1050 i := SectionIndex + 1; // first line after the section name
1051 while (i < uExams.Count) and (CharAt(uExams[i], 1) <> U) do
1052 begin
1053 Dest.Add(Pieces(uExams[i], U, 1, 2));
1054 Inc(i);
1055 end;
1056end;
1057
1058
1059
1060
1061
1062{------------------------------------------------------------------------------}
1063function EligbleConditions: TSCConditions;
1064{ return a record listing the conditions for which a patient is eligible }
1065var
1066 x: string;
1067begin
1068 x := sCallV('ORWPCE SCSEL', [Patient.DFN, Encounter.DateTime, uEncLocation]);
1069 with Result do
1070 begin
1071 SCAllow := Piece(Piece(x, ';', 1), U, 1) = '1';
1072 SCDflt := Piece(Piece(x, ';', 1), U, 2) = '1';
1073 AOAllow := Piece(Piece(x, ';', 2), U, 1) = '1';
1074 AODflt := Piece(Piece(x, ';', 2), U, 2) = '1';
1075 IRAllow := Piece(Piece(x, ';', 3), U, 1) = '1';
1076 IRDflt := Piece(Piece(x, ';', 3), U, 2) = '1';
1077 ECAllow := Piece(Piece(x, ';', 4), U, 1) = '1';
1078 ECDflt := Piece(Piece(x, ';', 4), U, 2) = '1';
1079 MSTAllow := Piece(Piece(x, ';', 5), U, 1) = '1';
1080 MSTDflt := Piece(Piece(x, ';', 5), U, 2) = '1';
1081 HNCAllow := Piece(Piece(x, ';', 6), U, 1) = '1';
1082 HNCDflt := Piece(Piece(x, ';', 6), U, 2) = '1';
1083 CVAllow := Piece(Piece(x, ';', 7), U, 1) = '1';
1084 CVDflt := Piece(Piece(x, ';', 7), U, 2) = '1';
1085 end;
1086end;
1087
1088procedure ListSCDisabilities(Dest: TStrings);
1089{ return text listing a patient's rated disabilities and % service connected }
1090begin
1091 CallV('ORWPCE SCDIS', [Patient.DFN]);
1092 Dest.Assign(RPCBrokerV.Results);
1093end;
1094
1095procedure LoadPCEDataForNote(Dest: TStrings; ANoteIEN: Integer; VStr: string);
1096begin
1097 if(ANoteIEN < 1) then
1098 CallV('ORWPCE PCE4NOTE', [ANoteIEN, Patient.DFN, VStr])
1099 else
1100 CallV('ORWPCE PCE4NOTE', [ANoteIEN]);
1101 Dest.Assign(RPCBrokerV.Results);
1102end;
1103
1104function GetVisitIEN(NoteIEN: Integer): string;
1105begin
1106 if(NoteIEN < 1) then
1107 CallV('ORWPCE GET VISIT', [NoteIEN, Patient.DFN, Encounter.VisitStr])
1108 else
1109 CallV('ORWPCE GET VISIT', [NoteIEN]);
1110 if(RPCBrokerV.Results.Count > 0) then
1111 Result := RPCBrokerV.Results[0]
1112 else
1113 Result := '0';
1114end;
1115
1116procedure SavePCEData(PCEList: TStringList; ANoteIEN, ALocation: integer);
1117begin
1118 CallV('ORWPCE SAVE', [PCEList, ANoteIEN, ALocation]);
1119end;
1120
1121{-----------------------------------------------------------------------------}
1122
1123function DataHasCPTCodes(AList: TStrings): boolean;
1124var
1125 i: integer;
1126 vl: string;
1127
1128begin
1129 if(not assigned(uHasCPT)) then
1130 uHasCPT := TStringList.Create;
1131 Result := FALSE;
1132 i := 0;
1133 while(i < AList.Count) do
1134 begin
1135 vl := uHasCPT.Values[AList[i]];
1136 if(vl = '1') then
1137 begin
1138 Result := TRUE;
1139 exit;
1140 end
1141 else
1142 if(vl = '0') then
1143 AList.Delete(i)
1144 else
1145 inc(i);
1146 end;
1147 if(AList.Count > 0) then
1148 begin
1149 with RPCBrokerV do
1150 begin
1151 ClearParameters := True;
1152 RemoteProcedure := 'ORWPCE HASCPT';
1153 Param[0].PType := list;
1154 with Param[0] do
1155 begin
1156 for i := 0 to AList.Count-1 do
1157 Mult[inttostr(i+1)] := AList[i];
1158 end;
1159 CallBroker;
1160 for i := 0 to RPCBrokerV.Results.Count-1 do
1161 begin
1162 if(Piece(RPCBrokerV.Results[i],'=',2) = '1') then
1163 begin
1164 Result := TRUE;
1165 break;
1166 end;
1167 end;
1168 uHasCPT.AddStrings(RPCBrokerV.Results);
1169 end;
1170 end;
1171end;
1172
1173function GetAskPCE(Loc: integer): TAskPCE;
1174begin
1175 if(uAPUser <> User.DUZ) or (uAPLoc <> Loc) then
1176 begin
1177 uAPUser := User.DUZ;
1178 uAPLoc := Loc;
1179 uAPAsk := TAskPCE(StrToIntDef(sCallV('ORWPCE ASKPCE', [User.DUZ, Loc]), 0));
1180 end;
1181 Result := uAPAsk;
1182end;
1183
1184function HasVisit(const ANoteIEN, ALocation: integer; const AVisitDate: TFMDateTime): Integer;
1185begin
1186 Result := StrToIntDef(sCallV('ORWPCE HASVISIT', [ANoteIEN, Patient.DFN, ALocation, AVisitDate]), -1);
1187end;
1188
1189{-----------------------------------------------------------------------------}
1190function CheckActivePerson(provider:String;DateTime:TFMDateTime): boolean;
1191var
1192 RetVal: String;
1193begin
1194 Callv('ORWPCE ACTIVE PROV',[provider,FloatToStr(DateTime)]);
1195 retval := RPCBrokerV.Results[0];
1196 if StrToInt(RetVal) = 1 then result := true
1197 else result := false;
1198end;
1199
1200function ForcePCEEntry(Loc: integer): boolean;
1201begin
1202 if(Loc <> uLastForceLoc) then
1203 begin
1204 uLastForce := (sCallV('ORWPCE FORCE', [User.DUZ, Loc]) = '1');
1205 uLastForceLoc := Loc;
1206 end;
1207 Result := uLastForce;
1208end;
1209
1210procedure LoadcboOther(Dest: TStrings; Location, fOtherApp: Integer);
1211{loads items into combo box on Immunization screen}
1212var
1213 IEN, RPC: string;
1214 TmpSL: TORStringList;
1215 i, j, idx, typ: integer;
1216
1217begin
1218 TmpSL := TORStringList.Create;
1219 try
1220 Idx := 0;
1221 case fOtherApp of
1222 PCE_IMM: begin typ := 1; RPC := 'ORWPCE GET IMMUNIZATION TYPE'; end;
1223 PCE_SK: begin typ := 2; RPC := 'ORWPCE GET SKIN TEST TYPE'; end;
1224 PCE_PED: begin typ := 3; RPC := 'ORWPCE GET EDUCATION TOPICS'; end;
1225 PCE_HF: begin typ := 4; RPC := 'ORWPCE GET HEALTH FACTORS TY'; Idx := 1; end;
1226 PCE_XAM: begin typ := 5; RPC := 'ORWPCE GET EXAM TYPE'; end;
1227 else begin typ := 0; RPC := ''; end;
1228 end;
1229 if typ > 0 then
1230 begin
1231 if idx = 0 then
1232 tCallV(TmpSL,RPC,[nil])
1233 else
1234 tCallV(TmpSL,RPC,[idx]);
1235 CallV('ORWPCE GET EXCLUDED', [Location, Typ]);
1236 for i := 0 to RPCBrokerV.Results.Count-1 do
1237 begin
1238 IEN := piece(RPCBrokerV.Results[i],U,2);
1239 idx := TmpSL.IndexOfPiece(IEN);
1240 if idx >= 0 then
1241 begin
1242 TmpSL.Delete(idx);
1243 if fOtherApp = PCE_HF then
1244 begin
1245 j := 0;
1246 while (j < TmpSL.Count) do
1247 begin
1248 if IEN = Piece(TmpSL[J],U,4) then
1249 TmpSL.Delete(j)
1250 else
1251 inc(j);
1252 end;
1253 end;
1254 end;
1255 end;
1256 end;
1257 Dest.Assign(TmpSL);
1258 finally
1259 TmpSL.Free;
1260 end;
1261end;
1262
1263{
1264function SetRPCEncouterInfo(PCEData: TPCEData): boolean;
1265begin
1266 if (SetRPCEncLocation(PCEData.location) = False) or (SetRPCEncDateTime(PCEData.DateTime) = False) then
1267 result := False
1268 else result := True;
1269end;
1270}
1271
1272function SetRPCEncLocation(Loc: Integer): boolean;
1273begin
1274 uEncLocation := Loc;
1275 Result := (uEncLocation <> 0);
1276end;
1277
1278{
1279function SetRPCEncDateTime(DT: TFMDateTime): boolean;
1280begin
1281 uEncDateTime := 0.0;
1282 result := False;
1283 uEncDateTime := DT;
1284 if uEncDateTime > 0.0 then result := true;
1285end;
1286}
1287
1288function PCERPCEncLocation: integer;
1289begin
1290 result := uEncLocation;
1291end;
1292
1293{
1294function PCERPCEncDateTime: TFMDateTime;
1295begin
1296 result := uEncDateTime;
1297end;
1298}
1299
1300function GetLocSecondaryVisitCode(Loc: integer): char;
1301begin
1302 if (Loc <> uLastIsClinicLoc) then
1303 begin
1304 uLastIsClinicLoc := Loc;
1305 uLastIsClinic := (sCallV('ORWPCE ISCLINIC', [Loc]) = '1');
1306 end;
1307 if uLastIsClinic then
1308 Result := 'I'
1309 else
1310 Result := 'D';
1311end;
1312
1313function GAFOK: boolean;
1314begin
1315 if(not uGAFOKCalled) then
1316 begin
1317 uGAFOK := (sCallV('ORWPCE GAFOK', []) = '1');
1318 uGAFOKCalled := TRUE;
1319 end;
1320 Result := uGAFOK;
1321end;
1322
1323function MHClinic(const Location: integer): boolean;
1324begin
1325 if GAFOK then
1326 Result := (sCallV('ORWPCE MHCLINIC', [Location]) = '1')
1327 else
1328 Result := FALSE;
1329end;
1330
1331procedure RecentGAFScores(const Limit: integer);
1332begin
1333 if(GAFOK) then
1334 begin
1335 with RPCBrokerV do
1336 begin
1337 ClearParameters := True;
1338 RemoteProcedure := 'ORWPCE LOADGAF';
1339 Param[0].PType := list;
1340 with Param[0] do
1341 begin
1342 Mult['"DFN"'] := Patient.DFN;
1343 Mult['"LIMIT"'] := IntToStr(Limit);
1344 end;
1345 CallBroker;
1346 end;
1347 end;
1348end;
1349
1350function SaveGAFScore(const Score: integer; GAFDate: TFMDateTime; Staff: Int64): boolean;
1351begin
1352 Result := FALSE;
1353 if(GAFOK) then
1354 begin
1355 with RPCBrokerV do
1356 begin
1357 ClearParameters := True;
1358 RemoteProcedure := 'ORWPCE SAVEGAF';
1359 Param[0].PType := list;
1360 with Param[0] do
1361 begin
1362 Mult['"DFN"'] := Patient.DFN;
1363 Mult['"GAF"'] := IntToStr(Score);
1364 Mult['"DATE"'] := FloatToStr(GAFDate);
1365 Mult['"STAFF"'] := IntToStr(Staff);
1366 end;
1367 CallBroker;
1368 end;
1369 if(RPCBrokerV.Results.Count > 0) and
1370 (RPCBrokerV.Results[0] = '1') then
1371 Result := TRUE;
1372 end;
1373end;
1374
1375function GAFURL: string;
1376begin
1377 if(not uGAFURLChecked) then
1378 begin
1379 uGAFURL := sCallV('ORWPCE GAFURL', []);
1380 uGAFURLChecked := TRUE;
1381 end;
1382 Result := uGAFURL;
1383end;
1384
1385function MHTestsOK: boolean;
1386begin
1387 if(not uMHOKChecked) then
1388 begin
1389 uMHOK := (sCallV('ORWPCE MHTESTOK', []) = '1');
1390 uMHOKChecked := TRUE;
1391 end;
1392 Result := uMHOK;
1393end;
1394
1395function MHTestAuthorized(Test: string): boolean;
1396begin
1397 Result := (sCallV('ORWPCE MH TEST AUTHORIZED', [Test, User.DUZ]) = '1');
1398end;
1399
1400function AnytimeEncounters: boolean;
1401begin
1402 if uAnytimeEnc < 0 then
1403 uAnytimeEnc := ord(sCallV('ORWPCE ANYTIME', []) = '1');
1404 Result := BOOLEAN(uAnytimeEnc);
1405end;
1406
1407function AutoCheckout(Loc: integer): boolean;
1408begin
1409 if(uLastChkOutLoc <> Loc) then
1410 begin
1411 uLastChkOutLoc := Loc;
1412 uLastChkOut := (sCallV('ORWPCE ALWAYS CHECKOUT', [Loc]) = '1');
1413 end;
1414 Result := uLastChkOut;
1415end;
1416
1417{ encounter capture functions ------------------------------------------------ }
1418
1419function RequireExposures(ANote, ATitle: Integer): Boolean; {*RAB 3/22/99*}
1420{ returns true if a progress note should require the expossure questions to be answered }
1421begin
1422 if ANote <= 0
1423 then Result := Piece(sCallV('TIU GET DOCUMENT PARAMETERS', ['0', ATitle]), U, 15) = '1'
1424 else Result := Piece(sCallV('TIU GET DOCUMENT PARAMETERS', [ANote]), U, 15) = '1';
1425end;
1426
1427function PromptForWorkload(ANote, ATitle: Integer; VisitCat: Char; StandAlone: boolean): Boolean;
1428{ returns true if a progress note should prompt for capture of encounter }
1429var
1430 X: string;
1431
1432begin
1433 Result := FALSE;
1434 if (VisitCat <> 'A') and (VisitCat <> 'I') and (VisitCat <> 'T') then exit;
1435 if ANote <= 0 then
1436 X := sCallV('TIU GET DOCUMENT PARAMETERS', ['0', ATitle])
1437 else
1438 X := sCallV('TIU GET DOCUMENT PARAMETERS', [ANote]);
1439 if(Piece(X, U, 14) = '1') then exit; // Suppress DX/CPT param is TRUE - don't ask
1440 if StandAlone then
1441 Result := TRUE
1442 else
1443 Result := (Piece(X, U, 16) = '1'); // Check Ask DX/CPT param
1444end;
1445
1446function IsCancelOrNoShow(ANote: integer): boolean;
1447begin
1448 Result := (sCallV('ORWPCE CXNOSHOW', [ANote]) = '0');
1449end;
1450
1451function IsNonCountClinic(ALocation: integer): boolean;
1452begin
1453 Result := (sCallV('ORWPCE1 NONCOUNT', [ALocation]) = '1');
1454end;
1455
1456function DefaultProvider(ALocation: integer; AUser: Int64; ADate: TFMDateTime;
1457 ANoteIEN: integer): string;
1458begin
1459 Result := sCallV('TIU GET DEFAULT PROVIDER', [ALocation, AUser, ADate, ANoteIEN]);
1460end;
1461
1462function IsUserAProvider(AUser: Int64; ADate: TFMDateTime): boolean;
1463begin
1464 Result := (sCallV('TIU IS USER A PROVIDER?', [AUser, ADate]) = '1');
1465end;
1466
1467//function HNCOK: boolean;
1468//begin
1469// if uHNCOK < 0 then
1470// uHNCOK := ord(sCallV('ORWPCE HNCOK', []) = '1');
1471// Result := boolean(uHNCOK);
1472//end;
1473
1474initialization
1475 uLastLocation := 0;
1476 uVTypeLastLoc := 0;
1477 uVTypeLastDate := 0;
1478 uDiagnoses := TStringList.Create;
1479 uExams := TStringList.Create;
1480 uHealthFactors := TStringList.Create;
1481 uImmunizations := TStringList.Create;
1482 uPatientEds := TStringList.Create;
1483 uProcedures := TStringList.Create;
1484 uSkinTests := TStringList.Create;
1485 uVisitTypes := TStringList.Create;
1486 uVTypeForLoc := TStringList.Create;
1487 uProblems := TStringList.Create;
1488
1489finalization
1490 uDiagnoses.Free;
1491 uExams.Free;
1492 uHealthFactors.Free;
1493 uImmunizations.Free;
1494 uPatientEds.Free;
1495 uProcedures.Free;
1496 uSkinTests.free;
1497 uVisitTypes.Free;
1498 uVTypeForLoc.Free;
1499 uProblems.Free;
1500 KillObj(@uModifiers);
1501 KillObj(@uHasCPT);
1502
1503end.
Note: See TracBrowser for help on using the repository browser.