Module

rPCE

Path

C:\CPRS\CPRS30\Encounter\rPCE.pas

Last Modified

10/7/2014 12:48:38 PM

Comments

REMOVE AFTER UNIT IS DEBUGGED

Initialization Code

initialization
  uLastLocation := 0;
  uVTypeLastLoc := 0;
  uVTypeLastDate := 0;
  uDiagnoses     := TStringList.Create;
  uExams         := TStringList.Create;
  uHealthFactors := TStringList.Create;
  uImmunizations := TStringList.Create;
  uPatientEds    := TStringList.Create;
  uProcedures    := TStringList.Create;
  uSkinTests     := TStringList.Create;
  uVisitTypes    := TStringList.Create;
  uVTypeForLoc   := TStringList.Create;
  uProblems      := TStringList.Create;

Finalization Code

finalization
  uDiagnoses.Free;
  uExams.Free;
  uHealthFactors.Free;
  uImmunizations.Free;
  uPatientEds.Free;
  uProcedures.Free;
  uSkinTests.free;
  uVisitTypes.Free;
  uVTypeForLoc.Free;
  uProblems.Free;
  KillObj(@uModifiers);
  KillObj(@uHasCPT);

end.

Units Used in Interface

Name Comments
UBACore -
uPCE -

Units Used in Implementation

Name Comments
fEncounterFrame -
rCore -
UBAConst -
UBAGlobals -
uConst -
uCore -

Procedures

Name Owner Declaration Scope Comments
AddProbsToDiagnoses - procedure AddProbsToDiagnoses; Interfaced -
DeletePCE - procedure DeletePCE(const AVisitStr: string); Interfaced
Encounter Form Elements
Encounter Form Elements ------------------------------------------------------------------
ListCPTModifiers - procedure ListCPTModifiers(Dest: TStrings; CPTCodes, NeededModifiers: string); Interfaced
CPTCodes expected in the format of code^code^code
NeededModifiers in format of ModIEN1;ModIEN2;ModIEN3
ListDiagnosisCodes - procedure ListDiagnosisCodes(Dest: TStrings; SectionIndex: Integer); Interfaced
Return diagnoses within section in format:
    diagnosis <TAB> ICDInteger <TAB> .ICDDecimal <TAB> ICD Code
ListDiagnosisSections - procedure ListDiagnosisSections(Dest: TStrings); Interfaced
Diagnosis---------------------------------------------------------------------

 return section names in format: ListIndex^SectionName (sections begin with '^')
ListExamsCodes - procedure ListExamsCodes(Dest: TStrings; SectionIndex: Integer); Interfaced Return PatientEds within section in format: procedure <TAB> CPT code <TAB><TAB> CPT code
ListExamsSections - procedure ListExamsSections(Dest: TStrings); Interfaced Return Sections in format: ListIndex^SectionName (sections begin with '^')
ListHealthCodes - procedure ListHealthCodes(Dest: TStrings; SectionIndex: Integer); Interfaced Return PatientEds within section in format: procedure <TAB> CPT code <TAB><TAB> CPT code
ListHealthSections - procedure ListHealthSections(Dest: TStrings); Interfaced Return Sections in format: ListIndex^SectionName (sections begin with '^')
ListImmunizCodes - procedure ListImmunizCodes(Dest: TStrings; SectionIndex: Integer); Interfaced Return procedures within section in format: procedure <TAB> CPT code <TAB><TAB> CPT code
ListImmunizSections - procedure ListImmunizSections(Dest: TStrings); Interfaced Return section names in format: ListIndex^SectionName (sections begin with '^')
ListLexicon - procedure ListLexicon(Dest: TStrings; const x: string; LexApp: Integer; ADate: TFMDateTime = 0; AExtend: Boolean = False; AI10Active: Boolean = False); Interfaced -
ListPatientCodes - procedure ListPatientCodes(Dest: TStrings; SectionIndex: Integer); Interfaced Return PatientEds within section in format: procedure <TAB> CPT code <TAB><TAB> CPT code
ListPatientSections - procedure ListPatientSections(Dest: TStrings); Interfaced Return Sections in format: ListIndex^SectionName (sections begin with '^')
ListProcedureCodes - procedure ListProcedureCodes(Dest: TStrings; SectionIndex: Integer); Interfaced
Return procedures within section in format: procedure <TAB> CPT code <TAB><TAB> CPT code
Piece 12 are CPT Modifiers, Piece 13 is a flag indicating conversion of Piece 12 from
modifier code to modifier IEN (updated in UpdateModifierList routine)
ListProcedureSections - procedure ListProcedureSections(Dest: TStrings); Interfaced
Procedures--------------------------------------------------------------------

 return section names in format: ListIndex^SectionName (sections begin with '^')
ListSCDisabilities - procedure ListSCDisabilities(Dest: TStrings); Interfaced Return text listing a patient's rated disabilities and % service connected
ListSkinCodes - procedure ListSkinCodes(Dest: TStrings; SectionIndex: Integer); Interfaced Return procedures within section in format: procedure <TAB> CPT code <TAB><TAB> CPT code
ListSkinSections - procedure ListSkinSections(Dest: TStrings); Interfaced Return section names in format: ListIndex^SectionName (sections begin with '^')
ListVisitTypeByLoc - procedure ListVisitTypeByLoc(Dest: TStrings; Location: Integer; ADateTime: TFMDateTime = 0); Interfaced -
ListVisitTypeCodes - procedure ListVisitTypeCodes(Dest: TStrings; SectionIndex: Integer); Interfaced Return visit types in format: visit type <TAB> amount of time <TAB> CPT code <TAB> CPT code
ListVisitTypeSections - procedure ListVisitTypeSections(Dest: TStrings); Interfaced
Visit Types-------------------------------------------------------------------

 return section names in format: ListIndex^SectionName (sections begin with '^')
LoadcboOther - procedure LoadcboOther(Dest: TStrings; Location, fOtherApp: Integer); Interfaced
"Other" form PCE calls
loads items into combo box on Immunization screen
LoadEncounterForm - procedure LoadEncounterForm; Global -
LoadHFLevelItems - procedure LoadHFLevelItems(Dest: TStrings); Interfaced HealthFactors-------------------------------------------------------------
LoadHistLocations - procedure LoadHistLocations(Dest: TStrings); Interfaced -
LoadImmReactionItems - procedure LoadImmReactionItems(Dest: TStrings); Interfaced Immunizations-----------------------------------------------------------------
LoadImmSeriesItems - procedure LoadImmSeriesItems(Dest: TStrings); Interfaced Loads items into combo box on Immunixation screen
LoadPCEDataForNote - procedure LoadPCEDataForNote(Dest: TStrings; ANoteIEN: Integer; VStr: string); Interfaced -
LoadPEDLevelItems - procedure LoadPEDLevelItems(Dest: TStrings); Interfaced Patient Education-------------------------------------------------------------
LoadSkResultsItems - procedure LoadSkResultsItems(Dest: TStrings); Interfaced SkinTests---------------------------------------------------------------------
LoadXAMResultsItems - procedure LoadXAMResultsItems(Dest: TStrings); Interfaced Exams-------------------------------------------------------------------------
RecentGAFScores - procedure RecentGAFScores(const Limit: integer); Interfaced -
SavePCEData - procedure SavePCEData(PCEList: TStringList; ANoteIEN, ALocation: integer); Interfaced -

Functions

Name Owner Declaration Scope Comments
AnytimeEncounters - function AnytimeEncounters: boolean; Interfaced -
AutoCheckout - function AutoCheckout(Loc: integer): boolean; Interfaced -
AutoSelectVisit - function AutoSelectVisit(Location: integer): boolean; Interfaced -
CheckActivePerson - function CheckActivePerson(provider:string;DateTime:TFMDateTime): boolean; Interfaced
Check for active person class on provider
-----------------------------------------------------------------------------
DataHasCPTCodes - function DataHasCPTCodes(AList: TStrings): boolean; Interfaced -----------------------------------------------------------------------------
DefaultProvider - function DefaultProvider(ALocation: integer; AUser: Int64; ADate: TFMDateTime; ANoteIEN: integer): string; Interfaced -
EligbleConditions - function EligbleConditions: TSCConditions; Interfaced
------------------------------------------------------------------------------

 return a record listing the conditions for which a patient is eligible
ForcePCEEntry - function ForcePCEEntry(Loc: integer): boolean; Interfaced -
GAFOK - function GAFOK: boolean; Interfaced GAF
GAFURL - function GAFURL: string; Interfaced -
GetAskPCE - function GetAskPCE(Loc: integer): TAskPCE; Interfaced -
GetDiagnosisText - function GetDiagnosisText(Narrative: String; Code: String): String; Interfaced -
GetFreqOfText - function GetFreqOfText(SearchStr: String): integer; Interfaced -
GetICDVersion - function GetICDVersion(ADate: TFMDateTime = 0): String; Interfaced -
GetLocSecondaryVisitCode - function GetLocSecondaryVisitCode(Loc: integer): char; Interfaced
Function PCERPCEncDateTime: TFMDateTime;
function PCERPCEncDateTime: TFMDateTime;
begin
  result := uEncDateTime;
end;
GetVisitCat - function GetVisitCat(InitialCat: char; Location: integer; Inpatient: boolean): char; Interfaced UHNCOK: integer = -1;
GetVisitIEN - function GetVisitIEN(NoteIEN: Integer): string; Interfaced -
HasVisit - function HasVisit(const ANoteIEN, ALocation: integer; const AVisitDate: TFMDateTime): Integer; Interfaced -
InsertTab - function InsertTab(x: string): string; Local -
IsActiveCode - function IsActiveCode(ACode: string; LexApp: integer; ADate: TFMDateTime = 0): boolean; Interfaced -
IsActiveCPTCode - function IsActiveCPTCode(ACode: string; ADate: TFMDateTime = 0): boolean; Interfaced -
IsActiveICDCode - function IsActiveICDCode(ACode: string; ADate: TFMDateTime = 0): boolean; Interfaced
Procedure GetI10Alternatives(Dest: TStrings; SCTCode: string);
TODO: Code for I10 mapped alternatives - remove if not reinstated as requirement
procedure GetI10Alternatives(Dest: TStrings; SCTCode: string);
begin
  CallV('ORWLEX GETALTS', [SCTCode, 'SCT']);
  FastAssign(RPCBrokerV.Results, Dest);
end;
IsActiveSCTCode - function IsActiveSCTCode(ACode: string; ADate: TFMDateTime = 0): boolean; Interfaced -
IsCancelOrNoShow - function IsCancelOrNoShow(ANote: integer): boolean; Interfaced -
IsNonCountClinic - function IsNonCountClinic(ALocation: integer): boolean; Interfaced -
IsUserAProvider - function IsUserAProvider(AUser: Int64; ADate: TFMDateTime): boolean; Interfaced -
IsUserAUSRProvider - function IsUserAUSRProvider(AUser: Int64; ADate: TFMDateTime): boolean; Interfaced -
LexiconToCode - function LexiconToCode(IEN, LexApp: Integer; ADate: TFMDateTime = 0): string; Interfaced
Lexicon Lookup Calls
Lexicon Lookup Calls
MHClinic - function MHClinic(const Location: integer): boolean; Interfaced -
MHTestAuthorized - function MHTestAuthorized(Test: string): boolean; Interfaced -
MHTestsOK - function MHTestsOK: boolean; Interfaced -
MixedCaseModifier - function MixedCaseModifier(const inStr: string): string; Global -
ModifierCode - function ModifierCode(ModIEN: string): string; Interfaced -
ModifierIdx - function ModifierIdx(ModIEN: string): integer; Global -
ModifierList - function ModifierList(CPTCode: string): string; Interfaced
UModifiers list contains <@>CPTCode;ModCount;^Mod1Index^Mod2Index^...^ModNIndex
    or                    MODIEN^MODDescription^ModCode
ModifierName - function ModifierName(ModIEN: string): string; Interfaced -
PCERPCEncLocation - function PCERPCEncLocation: integer; Interfaced
Function SetRPCEncDateTime(DT: TFMDateTime): boolean;
function SetRPCEncDateTime(DT: TFMDateTime): boolean;
begin
  uEncDateTime := 0.0;
  result := False;
  uEncDateTime := DT;
  if uEncDateTime > 0.0 then result := true;
end;
PromptForWorkload - function PromptForWorkload(ANote, ATitle: Integer; VisitCat: Char; StandAlone: boolean): Boolean; Interfaced Returns true if a progress note should prompt for capture of encounter
RequireExposures - function RequireExposures(ANote, ATitle: Integer): Boolean; Interfaced
Encounter 
function RequireExposures(ANote: Integer): Boolean;      {RAB}
encounter capture functions ------------------------------------------------ 

RAB 3/22/99*
 returns true if a progress note should require the expossure questions to be answered
SaveGAFScore - function SaveGAFScore(const Score: integer; GAFDate: TFMDateTime; Staff: Int64): boolean; Interfaced -
SetRPCEncLocation - function SetRPCEncLocation(Loc: Integer): boolean; Interfaced
Assign and read values from fPCEData
function SetRPCEncouterInfo(PCEData: TPCEData): boolean;
function SetRPCEncouterInfo(PCEData: TPCEData): boolean;
begin
  if (SetRPCEncLocation(PCEData.location) = False) or (SetRPCEncDateTime(PCEData.DateTime) = False) then
    result := False
  else result := True;
end;
UpdateModifierList - function UpdateModifierList(Dest: TStrings; Index: integer): string; Interfaced -
UpdateVisitTypeModifierList - function UpdateVisitTypeModifierList(Dest: TStrings; Index: integer): string; Interfaced -

Global Variables

Name Type Declaration Comments
uAnytimeEnc Integer uAnytimeEnc: integer = -1; -
uAPAsk uAPAsk: TAskPCE; -
uAPLoc Integer uAPLoc: integer = -2; -
uAPUser Int64 uAPUser: Int64 = -1; -
UAutoSelLoc Integer UAutoSelLoc: integer = -1; -
UAutoSelVal Boolean UAutoSelVal: boolean; -
uDiagnoses TStringList uDiagnoses: TStringList; -
uEncLocation Integer uEncLocation: integer; -
uExams TStringList uExams: TStringList; -
uGAFOK Boolean uGAFOK: boolean; -
uGAFOKCalled Boolean uGAFOKCalled: boolean = FALSE; -
uGAFURL UnicodeString uGAFURL: string; -
uGAFURLChecked Boolean uGAFURLChecked: boolean = FALSE; -
uHasCPT TStringList uHasCPT: TStringList = nil; -
uHealthFactors TStringList uHealthFactors: TStringList; -
uImmunizations TStringList uImmunizations: TStringList; -
uLastChkOut Boolean uLastChkOut: boolean; -
uLastChkOutLoc Integer uLastChkOutLoc: integer = -2; -
uLastDFN UnicodeString uLastDFN: String; -
uLastForce Boolean uLastForce: boolean; -
uLastForceLoc Integer uLastForceLoc: integer = -1; -
uLastIsClinic Boolean uLastIsClinic: boolean = FALSE; -
uLastIsClinicLoc Integer uLastIsClinicLoc: integer = 0; -
uLastLocation Integer uLastLocation: Integer; -
uMHOK Boolean uMHOK: boolean; -
uMHOKChecked Boolean uMHOKChecked: boolean = FALSE; -
uModifiers TORStringList uModifiers: TORStringList = nil; -
uPatientEds TStringList uPatientEds: TStringList; -
uProblems TStringList uProblems: TStringList; -
uProcedures TStringList uProcedures: TStringList; -
uSkinTests TStringList uSkinTests: TStringList; -
uVCInitialCat Char uVCInitialCat: char = #0; -
uVCInpatient Boolean uVCInpatient: boolean = FALSE; -
uVCLocation Integer uVCLocation: integer = -2; -
uVCResult Char uVCResult: char; -
uVisitTypes TStringList uVisitTypes: TStringList; -
uVTypeForLoc TStringList uVTypeForLoc: TStringList; -
uVTypeLastDate Double uVTypeLastDate: double = 0; -
uVTypeLastLoc Integer uVTypeLastLoc: Integer; -

Constants

Name Declaration Scope Comments
apAlways TAskPCE Interfaced -
apDisable TAskPCE Interfaced -
apNeeded TAskPCE Interfaced -
apNever TAskPCE Interfaced -
apOutpatient TAskPCE Interfaced -
apPrimaryAlways TAskPCE Interfaced -
apPrimaryNeeded TAskPCE Interfaced -
apPrimaryOutpatient TAskPCE Interfaced -
LX_CPT 13 Interfaced -
LX_ICD 12 Interfaced -
LX_SCT 14 Interfaced -
LX_Threshold 15 Interfaced -
PCE_HF 23 Interfaced -
PCE_IMM 20 Interfaced -
PCE_PED 22 Interfaced -
PCE_SK 21 Interfaced -
PCE_TRT 25 Interfaced -
PCE_XAM 24 Interfaced -
SCC_NA -1 Interfaced -
SCC_NO 0 Interfaced -
SCC_YES 1 Interfaced -


Module Source

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

Module Calls (2 levels)


rPCE
 ├uPCE
 │ ├uConst
 │ ├uCore
 │ ├rPCE...
 │ ├rCore
 │ ├rTIU
 │ ├fEncounterFrame
 │ ├uVitals
 │ ├fFrame
 │ ├fPCEProvider
 │ └rVitals
 ├UBACore
 │ ├uConst
 │ ├UBAGlobals
 │ ├fFrame...
 │ ├fReview
 │ ├rOrders
 │ ├uCore...
 │ ├rCore...
 │ └UBAConst
 ├rCore...
 ├uCore...
 ├uConst
 ├fEncounterFrame...
 ├UBAGlobals...
 └UBAConst

Module Called-By (2 levels)


                        rPCE
                   uOrders┤ 
                   uCore┤ │ 
                 fODBase┤ │ 
                 rODBase┤ │ 
                  fFrame┤ │ 
                 fOrders┤ │ 
             fOrdersSign┤ │ 
                   fMeds┤ │ 
               fARTAllgy┤ │ 
                  fNotes┤ │ 
               fConsults┤ │ 
         fReminderDialog┤ │ 
                 fReview┤ │ 
            fOrdersRenew┤ │ 
               fOrdersCV┤ │ 
                 fODMeds┤ │ 
                 fOMNavA┤ │ 
         fOrderSaveQuick┤ │ 
                  fOMSet┤ │ 
          fOrdersRelease┤ │ 
                 fOMHTML┤ │ 
               fODMedNVA┤ │ 
fODChangeUnreleasedRenew┤ │ 
          fOrdersOnChart┤ │ 
         fODReleaseEvent┤ │ 
               fODActive┘ │ 
                uReminders┤ 
               fFrame...┤ │ 
                fDrawers┤ │ 
                  fCover┤ │ 
                  rCover┤ │ 
               fNotes...┤ │ 
            fConsults...┤ │ 
         fTemplateEditor┤ │ 
      fReminderDialog...┤ │ 
           fReminderTree┤ │ 
              rReminders┤ │ 
                fSurgery┤ │ 
          fRemCoverSheet┘ │ 
                      uPCE┤ 
           uReminders...┤ │ 
                 rPCE...┤ │ 
         fEncounterFrame┤ │ 
              fVisitType┤ │ 
           mVisitRelated┤ │ 
              fDiagnoses┤ │ 
            fPCEBaseMain┤ │ 
              fProcedure┤ │ 
           fImmunization┤ │ 
               fSkinTest┤ │ 
              fPatientEd┤ │ 
           fHealthFactor┤ │ 
                   fExam┤ │ 
               fNotes...┤ │ 
            fConsults...┤ │ 
            fPCEProvider┤ │ 
                 fDCSumm┤ │ 
      fReminderDialog...┤ │ 
             fSurgery...┤ │ 
            fDCSummProps┤ │ 
                    fGAF┤ │ 
       fRemCoverSheet...┤ │ 
                fPCEEdit┘ │ 
         fBALocalDiagnoses┤ 
              UBAGlobals┤ │ 
          fOrdersSign...┤ │ 
              fReview...┤ │ 
              fODConsult┘ │ 
                   fPCELex┤ 
    fBALocalDiagnoses...┤ │ 
           fDiagnoses...┤ │ 
         fPCEBaseMain...┤ │ 
     fBAOptionsDiagnoses┤ │ 
           fODConsult...┤ │ 
                 fODProc┤ │ 
               fEditProc┤ │ 
            fEditConsult┘ │ 
        fEncounterFrame...┤ 
             fVisitType...┤ 
          mVisitRelated...┤ 
             fDiagnoses...┤ 
           fPCEBaseMain...┤ 
             fProcedure...┤ 
                 fPCEOther┤ 
         fPCEBaseMain...┘ │ 
          fImmunization...┤ 
              fSkinTest...┤ 
             fPatientEd...┤ 
          fHealthFactor...┤ 
                  fExam...┤ 
                fEncVitals┤ 
      fEncounterFrame...┘ │ 
                mCoPayDesc┤ 
          fOrdersSign...┤ │ 
              fReview...┘ │ 
                 fNotes...┤ 
                    fEncnt┤ 
              uOrders...┤ │ 
               fFrame...┤ │ 
                 fVitals┤ │ 
               fNotes...┤ │ 
                  fProbs┤ │ 
            fConsults...┤ │ 
              fDCSumm...┤ │ 
             fSurgery...┤ │ 
             fPCEEdit...┘ │ 
                 fProbs...┤ 
                  fProbEdt┤ 
               fProbs...┘ │ 
                  fProbLex┤ 
               fProbs...┤ │ 
             fProbEdt...┘ │ 
              fConsults...┤ 
                fDCSumm...┤ 
        fReminderDialog...┤ 
    fBAOptionsDiagnoses...┤ 
               fSurgery...┤ 
             fODConsult...┤ 
                fODProc...┤ 
              fAddlSigners┤ 
               fNotes...┤ │ 
            fConsults...┤ │ 
              fDCSumm...┤ │ 
             fSurgery...┘ │ 
           fDCSummProps...┤ 
              fEditProc...┤ 
           fEditConsult...┤ 
                   fGAF...┤ 
                 fHFSearch┘ 
         fPCEBaseMain...┘