Module

rODLab

Path

C:\CPRS\CPRS30\Orders\rODLab.pas

Last Modified

7/15/2014 3:26:42 PM

Units Used in Interface

Name Comments
rCore -
uCore -

Units Used in Implementation

Name Comments
rODBase -

Procedures

Name Owner Declaration Scope Comments
CheckForChangeFromLCtoWCOnAccept - procedure CheckForChangeFromLCtoWCOnAccept(Dest: TStrings; ALocation: integer; AStartDate, ACollType, ASchedule, ADuration: string); Interfaced -
CheckForChangeFromLCtoWCOnRelease - procedure CheckForChangeFromLCtoWCOnRelease(Dest: TStrings; ALocation: integer; OrderList: TStringList); Interfaced -
FormatLCtoWCDisplayTextOnAccept - procedure FormatLCtoWCDisplayTextOnAccept(InputList, OutputList: TStrings); Interfaced -
FormatLCtoWCDisplayTextOnRelease - procedure FormatLCtoWCDisplayTextOnRelease(InputList, OutputList: TStrings); Interfaced -
GetBloodComponents - procedure GetBloodComponents(Dest: TStrings); Interfaced -
GetDiagnosticTests - procedure GetDiagnosticTests(Dest: TStrings); Interfaced -
GetLabTimesForDate - procedure GetLabTimesForDate(Dest: TStrings; LabDate: TFMDateTime; Location: integer); Interfaced -
GetPatientBBInfo - procedure GetPatientBBInfo(Dest: TStrings; PatientID: string; Loc: integer); Interfaced -
GetPatientBloodResults - procedure GetPatientBloodResults(Dest: TStrings; PatientID: string; ATests: TStringList); Interfaced -
GetPatientBloodResultsRaw - procedure GetPatientBloodResultsRaw(Dest: TStrings; PatientID: string; ATests: TStringList); Interfaced -
ListForQuickOrders - procedure ListForQuickOrders(var AListIEN, ACount: Integer; const DGrpNm: string); Interfaced -
LoadLabTestData - procedure LoadLabTestData(LoadData: TStringList; LabTestIEN: string) ; Interfaced -
LoadSamples - procedure LoadSamples(LoadList: TStringList) ; Interfaced -
LoadSpecimens - procedure LoadSpecimens(SpecimenList: TStringList) ; Interfaced -
SubsetOfQuickOrders - procedure SubsetOfQuickOrders(Dest: TStringList; AListIEN, First, Last: Integer); Interfaced -

Functions

Name Owner Declaration Scope Comments
CalcStopDate - function CalcStopDate(Text: string): string ; Interfaced -
GetDefaultImmCollTime - function GetDefaultImmCollTime: TFMDateTime; Interfaced -
GetDiagnosticPanelLocation - function GetDiagnosticPanelLocation: boolean; Interfaced -
GetLastCollectionTime - function GetLastCollectionTime: string; Interfaced -
GetLCtoWCInstructions - function GetLCtoWCInstructions(Alocation: integer): string; Interfaced -
GetOneCollSamp - function GetOneCollSamp(LRFSAMP: integer): TStrings; Interfaced -
GetOneSpecimen - function GetOneSpecimen(LRFSPEC: integer): string; Interfaced -
GetSubtype - function GetSubtype(TestName: string): string; Interfaced -
ImmediateCollectTimes - function ImmediateCollectTimes: TStrings; Interfaced -
IsLabCollectTime - function IsLabCollectTime(ADateTime: TFMDateTime; Location: integer): boolean; Interfaced -
LabCollectFutureDays - function LabCollectFutureDays(Location: integer; Division: integer = 0): integer; Interfaced -
MaxDays - function MaxDays(Location, Schedule: integer): integer; Interfaced -
NursAdminSuppress - function NursAdminSuppress: boolean; Interfaced -
ODForLab - function ODForLab(Location: integer; Division: integer = 0): TStrings; Interfaced
Laboratory Ordering Calls
Returns init values for laboratory dialog.  The results must be used immediately.
RemoveCollTimeDefault - function RemoveCollTimeDefault: boolean; Interfaced -
StatAllowed - function StatAllowed(PatientID: string): boolean; Interfaced -
SubsetOfSpecimens - function SubsetOfSpecimens(const StartFrom: string; Direction: Integer): TStrings; Interfaced -
TNSDaysBack - function TNSDaysBack: integer; Interfaced -
ValidImmCollTime - function ValidImmCollTime(CollTime: TFMDateTime): string; Interfaced -

Constants

Name Declaration Scope Comments
TX_BLANK '' Interfaced -
TX0 'The following Lab orders will be changed to Ward Collect:' Interfaced -
TX2 'Order Date' + #9 +#9 + 'Reason Changed to Ward Collect' Interfaced -
TX5 'Please contact the ward staff to insure the specimen is collected.' Interfaced -
TX6 'You can print this screen for reference.' Interfaced -


Module Source

1     unit rODLab;
2     
3     interface
4     
5     uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, TRPCB, dialogs ;
6     
7          { Laboratory Ordering Calls }
8     function  ODForLab(Location: integer; Division: integer = 0): TStrings;
9     procedure LoadLabTestData(LoadData: TStringList; LabTestIEN: string) ;
10    procedure LoadSamples(LoadList: TStringList) ;
11    procedure LoadSpecimens(SpecimenList: TStringList) ;
12    function  SubsetOfSpecimens(const StartFrom: string; Direction: Integer): TStrings;
13    function  CalcStopDate(Text: string): string ;
14    function  MaxDays(Location, Schedule: integer): integer;
15    function  IsLabCollectTime(ADateTime: TFMDateTime; Location: integer): boolean;
16    function  ImmediateCollectTimes: TStrings;
17    function  LabCollectFutureDays(Location: integer; Division: integer = 0): integer;
18    function  GetDefaultImmCollTime: TFMDateTime;
19    function  ValidImmCollTime(CollTime: TFMDateTime): string;
20    function  GetOneCollSamp(LRFSAMP: integer): TStrings;
21    function  GetOneSpecimen(LRFSPEC: integer): string;
22    procedure GetLabTimesForDate(Dest: TStrings; LabDate: TFMDateTime; Location: integer);
23    function  GetLastCollectionTime: string;
24    procedure GetPatientBBInfo(Dest: TStrings; PatientID: string; Loc: integer);
25    procedure ListForQuickOrders(var AListIEN, ACount: Integer; const DGrpNm: string);
26    procedure SubsetOfQuickOrders(Dest: TStringList; AListIEN, First, Last: Integer);
27    procedure GetPatientBloodResults(Dest: TStrings; PatientID: string; ATests: TStringList);
28    procedure GetPatientBloodResultsRaw(Dest: TStrings; PatientID: string; ATests: TStringList);
29    function  StatAllowed(PatientID: string): boolean;
30    function  RemoveCollTimeDefault: boolean;
31    function  GetDiagnosticPanelLocation: boolean;
32    procedure GetBloodComponents(Dest: TStrings);
33    procedure GetDiagnosticTests(Dest: TStrings);
34    function  NursAdminSuppress: boolean;
35    function  GetSubtype(TestName: string): string;
36    function  TNSDaysBack: integer;
37    procedure CheckForChangeFromLCtoWCOnAccept(Dest: TStrings; ALocation: integer; AStartDate, ACollType, ASchedule, ADuration: string);
38    procedure CheckForChangeFromLCtoWCOnRelease(Dest: TStrings; ALocation: integer; OrderList: TStringList);
39    function  GetLCtoWCInstructions(Alocation: integer): string;
40    procedure FormatLCtoWCDisplayTextOnAccept(InputList, OutputList: TStrings);
41    procedure FormatLCtoWCDisplayTextOnRelease(InputList, OutputList: TStrings);
42    
43    const
44      TX0 = 'The following Lab orders will be changed to Ward Collect:';
45      TX2 = 'Order Date' + #9 +#9 + 'Reason Changed to Ward Collect';
46      TX5 = 'Please contact the ward staff to insure the specimen is collected.';
47      TX6 = 'You can print this screen for reference.';
48      TX_BLANK = '';
49    
50    implementation
51    
52    uses  rODBase;
53    
54    procedure GetBloodComponents(Dest: TStrings);
55    begin
56      tCallV(Dest, 'ORWDXVB COMPORD', []);
57    end;
58    
59    procedure GetDiagnosticTests(Dest: TStrings);
60    begin
61      tCallV(Dest, 'ORWDXVB3 DIAGORD', []);
62    end;
63    
64    function NursAdminSuppress: boolean;
65    begin
66      Result := (StrToInt(sCallV('ORWDXVB NURSADMN',[nil])) < 1);
67    end;
68    
69    function  StatAllowed(PatientID: string): boolean;
70    begin
71      Result := (StrToInt(sCallV('ORWDXVB STATALOW',[PatientID])) > 0);
72    end;
73    
74    function  RemoveCollTimeDefault: boolean;
75    begin
76      Result := (StrToInt(sCallV('ORWDXVB3 COLLTIM',[nil])) > 0);
77    end;
78    
79    function  GetDiagnosticPanelLocation: boolean;
80    begin
81      Result := (StrToInt(sCallV('ORWDXVB3 SWPANEL',[nil])) > 0);
82    end;
83    
84    procedure GetPatientBloodResultsRaw(Dest: TStrings; PatientID: string; ATests: TStringList);
85    begin
86      tCallV(Dest, 'ORWDXVB RAW', [PatientID, ATests]);
87    end;
88    
89    procedure GetPatientBloodResults(Dest: TStrings; PatientID: string; ATests: TStringList);
90    begin
91      tCallV(Dest, 'ORWDXVB RESULTS', [PatientID, ATests]);
92    end;
93    
94    procedure GetPatientBBInfo(Dest: TStrings; PatientID: string; Loc: integer);
95    begin
96      tCallV(Dest, 'ORWDXVB GETALL', [PatientID, Loc]);
97    end;
98    
99    function GetSubtype(TestName: string): string;
100   begin
101     Result := sCallV('ORWDXVB SUBCHK', [TestName]);
102   end;
103   
104   function TNSDaysBack: integer;
105   begin
106     Result := StrToIntDef(sCallV('ORWDXVB VBTNS', [nil]),3);
107   end;
108   
109   procedure ListForQuickOrders(var AListIEN, ACount: Integer; const DGrpNm: string);
110   begin
111     CallV('ORWUL QV4DG', [DGrpNm]);
112     AListIEN := StrToIntDef(Piece(RPCBrokerV.Results[0], U, 1), 0);
113     ACount   := StrToIntDef(Piece(RPCBrokerV.Results[0], U, 2), 0);
114   end;
115   
116   procedure SubsetOfQuickOrders(Dest: TStringList; AListIEN, First, Last: Integer);
117   var
118     i: Integer;
119   begin
120    CallV('ORWUL QVSUB', [AListIEN,'','']);
121    for i := 0 to RPCBrokerV.Results.Count -1 do
122      Dest.Add(RPCBrokerV.Results[i]);
123   end;
124   
125   function ODForLab(Location, Division: integer): TStrings;
126   { Returns init values for laboratory dialog.  The results must be used immediately. }
127   begin
128     CallV('ORWDLR32 DEF', [Location,Division]);
129     Result := RPCBrokerV.Results;
130   end;
131   
132   procedure LoadLabTestData(LoadData: TStringList; LabTestIEN: string) ;
133   begin
134       tCallV(LoadData, 'ORWDLR32 LOAD', [LabTestIEN]);
135   end ;
136   
137   procedure LoadSamples(LoadList: TStringList) ;
138   begin
139       tCallV(LoadList, 'ORWDLR32 ALLSAMP', [nil]);
140   end ;
141   
142   function SubsetOfSpecimens(const StartFrom: string; Direction: Integer): TStrings;
143   begin
144     Callv('ORWDLR32 ALLSPEC',[StartFrom, Direction]);
145     Result := RPCBrokerV.Results;
146   end ;
147   
148   procedure LoadSpecimens(SpecimenList: TStringList) ;
149   begin
150     tCallV(SpecimenList, 'ORWDLR32 ABBSPEC', [nil]);
151   end ;
152   
153   function CalcStopDate(Text: string): string ;
154   begin
155     Result := sCallV('ORWDLR32 STOP', [Text]);
156   end ;
157   
158   function MaxDays(Location, Schedule: integer): integer;
159   begin
160     Result := StrToInt(sCallV('ORWDLR32 MAXDAYS',[Location, Schedule]));
161   end;
162   
163   function IsLabCollectTime(ADateTime: TFMDateTime; Location: integer): boolean;
164   begin
165     Result := (StrToInt(sCallV('ORWDLR32 LAB COLL TIME',[ADateTime,Location])) > 0);
166   end;
167   
168   function  LabCollectFutureDays(Location: integer; Division: integer): integer;
169   begin
170     Result := StrToInt(sCallV('ORWDLR33 FUTURE LAB COLLECTS',[Location, Division]));
171   end;
172   
173   function  ImmediateCollectTimes: TStrings;
174   begin
175     CallV('ORWDLR32 IMMED COLLECT',[nil]);
176     Result := RPCBrokerV.Results;
177   end;
178   
179   function  GetDefaultImmCollTime: TFMDateTime;
180   begin
181     CallV('ORWDLR32 IC DEFAULT',[nil]);
182     Result := StrToFloat(Piece(RPCBrokerV.Results[0], U, 1));
183   end;
184   
185   function  ValidImmCollTime(CollTime: TFMDateTime): string;
186   begin
187     CallV('ORWDLR32 IC VALID',[CollTime]);
188     Result := RPCBrokerV.Results[0];
189   end;
190   
191   function  GetOneCollSamp(LRFSAMP: integer): TStrings;
192   begin
193     CallV('ORWDLR32 ONE SAMPLE', [LRFSAMP]);
194     Result := RPCBrokerV.Results;
195   end;
196   
197   function  GetOneSpecimen(LRFSPEC: integer): string;
198   begin
199     Result := sCallV('ORWDLR32 ONE SPECIMEN', [LRFSPEC]);
200   end;
201   
202   function  GetLastCollectionTime: string;
203   begin
204     Result := sCallV('ORWDLR33 LASTTIME', [nil]);
205   end
206   ;
207   procedure GetLabTimesForDate(Dest: TStrings; LabDate: TFMDateTime; Location: integer);
208   var
209     Prefix: string;
210     i: integer;
211   begin
212     CallV('ORWDLR32 GET LAB TIMES', [LabDate, Location]);
213     with Dest do
214       begin
215         Assign(RPCBrokerV.Results);
216         if (Count > 0) and (Piece(Strings[0], U, 1) <> '-1') then
217           for i := 0 to Count - 1 do
218             begin
219               if Strings[i] > '1159' then Prefix := 'PM Collection:  ' else Prefix := 'AM Collection:  ';
220               Strings[i] := Strings[i] + U + Prefix + Copy(Strings[i], 1, 2) + ':' + Copy(Strings[i], 3, 2);
221             end;
222       end;
223   end;
224   
225   procedure CheckForChangeFromLCtoWCOnAccept(Dest: TStrings; ALocation: integer; AStartDate, ACollType, ASchedule, ADuration: string);
226   var
227     AList: TStringList;
228   begin
229     AList := TStringList.Create;
230     try
231       CallV('ORCDLR2 CHECK ONE LC TO WC', [ALocation, '', AStartDate, ACollType, ASchedule, ADuration]);
232       FastAssign(RPCBrokerV.Results, AList);
233       FormatLCtoWCDisplayTextOnAccept(AList, Dest);
234     finally
235       AList.Free;
236     end;
237   end;
238   
239   procedure CheckForChangeFromLCtoWCOnRelease(Dest: TStrings; ALocation: integer; OrderList: TStringList);
240   var
241     AList: TStringList;
242   begin
243     AList := TStringList.Create;
244     try
245       CallV('ORCDLR2 CHECK ALL LC TO WC', [ALocation, OrderList]);
246       FastAssign(RPCBrokerV.Results, AList);
247       FormatLCtoWCDisplayTextOnRelease(AList, Dest);
248     finally
249       AList.Free;
250     end;
251   end;
252   
253   procedure FormatLCtoWCDisplayTextOnAccept(InputList, OutputList: TStrings);
254   var
255     i: integer;
256     x: string;
257   begin
258     OutputList.Clear;
259     for i := InputList.Count - 1 downto 0 do
260       if Piece(InputList[i], U, 2) = '1' then InputList.Delete(i);
261     if InputList.Count > 0 then
262     begin
263       SetListFMDateTime('mmm dd, yyyy@hh:nn', TStringList(InputList), U, 1);
264       with OutputList do
265       begin
266         Add(TX0);
267         Add(TX_BLANK);
268         Add('Patient :' + #9 + Patient.Name);
269         Add('SSN     :' + #9 + Patient.SSN);
270         Add('Location:' + #9 + Encounter.LocationName + CRLF);
271         for i := 0 to InputList.Count - 1 do
272           Add(Piece(InputList[i], U, 1) + #9 + Piece(InputList[i], U, 3));
273         Add(TX_BLANK);
274         x := GetLCtoWCInstructions(Encounter.Location);
275         if x = '' then x := TX5;
276         Add(x);
277         Add(TX6);
278       end;
279     end;
280   end;
281   
282   procedure FormatLCtoWCDisplayTextOnRelease(InputList, OutputList: TStrings);
283   var
284     i, j, k, Changed: integer;
285     AList: TStringlist;
286     x: string;
287   begin
288     OutputList.Clear;
289     Changed := StrToIntDef(ExtractDefault(InputList, 'COUNT'), 0);
290     if Changed > 0 then
291     begin
292       AList := TStringList.Create;
293       try
294         with OutputList do
295         begin
296           Add(TX0);
297           Add(TX_BLANK);
298           Add('Patient :' + #9 + Patient.Name);
299           Add('SSN     :' + #9 + Patient.SSN);
300           Add('Location:' + #9 + Encounter.LocationName);
301           for i := 1 to Changed do
302           begin
303             Add(TX_BLANK);
304             AList.Clear;
305             ExtractText(AList, InputList, 'ORDER_' + IntToStr(i));
306             Add('Order   :' + #9 + AList[0]);
307             k := Length(OutputList[Count-1]);
308             if AList.Count > 1 then
309               for j := 1 to AList.Count - 1 do
310               begin
311                 Add(StringOfChar(' ', 9) + #9 + AList[j]);
312                 k := HigherOf(k, Length(OutputList[Count - 1]));
313               end;
314             Add(StringOfChar('-', k + 4));
315             AList.Clear;
316             ExtractItems(AList, InputList, 'ORDER_' + IntToStr(i));
317             SetListFMDateTime('mmm dd, yyyy@hh:nn', AList, U, 1);
318             for j := 0 to AList.Count - 1 do
319               OutputList.Add(Piece(AList[j], U, 1) + #9 + Piece(AList[j], U, 3));
320           end;
321           Add(TX_BLANK);
322           x := GetLCtoWCInstructions(Encounter.Location);
323           if x = '' then x := TX5;
324           Add(x);
325           Add(TX6);
326         end;
327       finally
328         AList.Free;
329       end;
330     end;
331   end;
332   
333   function GetLCtoWCInstructions(Alocation: integer): string;
334   begin
335     Result := sCallV('ORWDLR33 LC TO WC', [Encounter.Location]);
336   end;
337   
338   end.

Module Calls (2 levels)


rODLab
 └uCore
   ├rCore
   ├uConst
   ├uCombatVet
   ├rTIU
   ├rOrders
   ├rConsults
   └uOrders

Module Called-By (2 levels)


               rODLab
        fOrdersSign┤ 
       UBAGlobals┤ │ 
           fFrame┤ │ 
          fOrders┤ │ 
fBALocalDiagnoses┤ │ 
          fReview┤ │ 
       uSignItems┘ │ 
         fReview...┤ 
             fODLab┤ 
          uOrders┤ │ 
fODLabOthCollSamp┘ │ 
      fODLabOthSpec┤ 
        fODLab...┤ │ 
         fODBBank┘ │ 
    fODLabImmedColl┤ 
        fODLab...┤ │ 
      fODBBank...┘ │ 
      fLabCollTimes┤ 
        fODLab...┤ │ 
      fODBBank...┘ │ 
        fODBBank...┤ 
     fOrdersRelease┤ 
       fOrders...┘ │ 
     fOrdersOnChart┤ 
       fOrders...┘ │ 
    fODReleaseEvent┘ 
       fOrders...┘