source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/rODLab.pas@ 1742

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

Initial upload of TMG-CPRS 1.0.26.69

File size: 5.3 KB
RevLine 
[453]1//kt -- Modified with SourceScanner on 8/8/2007
2unit rODLab;
3
4interface
5
6uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, TRPCB, dialogs ;
7
8 { Laboratory Ordering Calls }
9function ODForLab(Location: integer; Division: integer = 0): TStrings;
10procedure LoadLabTestData(LoadData: TStringList; LabTestIEN: string) ;
11procedure LoadSamples(LoadList: TStringList) ;
12procedure LoadSpecimens(SpecimenList: TStringList) ;
13function SubsetOfSpecimens(const StartFrom: string; Direction: Integer): TStrings;
14function CalcStopDate(Text: string): string ;
15function MaxDays(Location, Schedule: integer): integer;
16function IsLabCollectTime(ADateTime: TFMDateTime; Location: integer): boolean;
17function ImmediateCollectTimes: TStrings;
18function LabCollectFutureDays(Location: integer; Division: integer = 0): integer;
19function GetDefaultImmCollTime: TFMDateTime;
20function ValidImmCollTime(CollTime: TFMDateTime): string;
21function GetOneCollSamp(LRFSAMP: integer): TStrings;
22function GetOneSpecimen(LRFSPEC: integer): string;
23procedure GetLabTimesForDate(Dest: TStrings; LabDate: TFMDateTime; Location: integer);
24function GetLastCollectionTime: string;
25procedure GetPatientBBInfo(Dest: TStrings; PatientID: string; Loc: integer);
26procedure GetPatientBloodResults(Dest: TStrings; PatientID: string; ATests: TStringList);
27procedure GetPatientBloodResultsRaw(Dest: TStrings; PatientID: string; ATests: TStringList);
28function StatAllowed(PatientID: string): boolean;
29procedure GetBloodComponents(Dest: TStrings);
30
31implementation
32
33uses rODBase
34 , DKLang //kt
35 ;
36(* fODBase, rODBase, fODLab;*)
37
38procedure GetBloodComponents(Dest: TStrings);
39begin
40 tCallV(Dest, 'ORWDXVB COMPORD', []);
41end;
42
43function StatAllowed(PatientID: string): boolean;
44begin
45 Result := (StrToInt(sCallV('ORWDXVB STATALOW',[PatientID])) > 0);
46end;
47
48procedure GetPatientBloodResultsRaw(Dest: TStrings; PatientID: string; ATests: TStringList);
49begin
50 tCallV(Dest, 'ORWDXVB RAW', [PatientID, ATests]);
51end;
52
53procedure GetPatientBloodResults(Dest: TStrings; PatientID: string; ATests: TStringList);
54begin
55 tCallV(Dest, 'ORWDXVB RESULTS', [PatientID, ATests]);
56end;
57
58procedure GetPatientBBInfo(Dest: TStrings; PatientID: string; Loc: integer);
59begin
60 tCallV(Dest, 'ORWDXVB GETALL', [PatientID, Loc]);
61end;
62
63function ODForLab(Location, Division: integer): TStrings;
64{ Returns init values for laboratory dialog. The results must be used immediately. }
65begin
66 CallV('ORWDLR32 DEF', [Location,Division]);
67 Result := RPCBrokerV.Results;
68end;
69
70procedure LoadLabTestData(LoadData: TStringList; LabTestIEN: string) ;
71begin
72 tCallV(LoadData, 'ORWDLR32 LOAD', [LabTestIEN]);
73end ;
74
75procedure LoadSamples(LoadList: TStringList) ;
76begin
77 tCallV(LoadList, 'ORWDLR32 ALLSAMP', [nil]);
78end ;
79
80function SubsetOfSpecimens(const StartFrom: string; Direction: Integer): TStrings;
81begin
82 Callv('ORWDLR32 ALLSPEC',[StartFrom, Direction]);
83 Result := RPCBrokerV.Results;
84end ;
85
86procedure LoadSpecimens(SpecimenList: TStringList) ;
87begin
88 tCallV(SpecimenList, 'ORWDLR32 ABBSPEC', [nil]);
89end ;
90
91function CalcStopDate(Text: string): string ;
92begin
93 Result := sCallV('ORWDLR32 STOP', [Text]);
94end ;
95
96function MaxDays(Location, Schedule: integer): integer;
97begin
98 Result := StrToInt(sCallV('ORWDLR32 MAXDAYS',[Location, Schedule]));
99end;
100
101function IsLabCollectTime(ADateTime: TFMDateTime; Location: integer): boolean;
102begin
103 Result := (StrToInt(sCallV('ORWDLR32 LAB COLL TIME',[ADateTime,Location])) > 0);
104end;
105
106function LabCollectFutureDays(Location: integer; Division: integer): integer;
107begin
108 Result := StrToInt(sCallV('ORWDLR33 FUTURE LAB COLLECTS',[Location, Division]));
109end;
110
111function ImmediateCollectTimes: TStrings;
112begin
113 CallV('ORWDLR32 IMMED COLLECT',[nil]);
114 Result := RPCBrokerV.Results;
115end;
116
117function GetDefaultImmCollTime: TFMDateTime;
118begin
119 CallV('ORWDLR32 IC DEFAULT',[nil]);
120 Result := StrToFloat(Piece(RPCBrokerV.Results[0], U, 1));
121end;
122
123function ValidImmCollTime(CollTime: TFMDateTime): string;
124begin
125 CallV('ORWDLR32 IC VALID',[CollTime]);
126 Result := RPCBrokerV.Results[0];
127end;
128
129function GetOneCollSamp(LRFSAMP: integer): TStrings;
130begin
131 CallV('ORWDLR32 ONE SAMPLE', [LRFSAMP]);
132 Result := RPCBrokerV.Results;
133end;
134
135function GetOneSpecimen(LRFSPEC: integer): string;
136begin
137 Result := sCallV('ORWDLR32 ONE SPECIMEN', [LRFSPEC]);
138end;
139
140function GetLastCollectionTime: string;
141begin
142 Result := sCallV('ORWDLR33 LASTTIME', [nil]);
143end
144;
145procedure GetLabTimesForDate(Dest: TStrings; LabDate: TFMDateTime; Location: integer);
146var
147 Prefix: string;
148 i: integer;
149begin
150 CallV('ORWDLR32 GET LAB TIMES', [LabDate, Location]);
151 with Dest do
152 begin
153 Assign(RPCBrokerV.Results);
154 if (Count > 0) and (Piece(Strings[0], U, 1) <> '-1') then
155 for i := 0 to Count - 1 do
156 begin
157// if Strings[i] > '1159' then Prefix := 'PM Collection: ' else Prefix := 'AM Collection: '; <-- original line. //kt 8/8/2007
158 if Strings[i] > '1159' then Prefix := DKLangConstW('rODLab_PM_Collectionx')+' ' else Prefix := DKLangConstW('rODLab_AM_Collectionx')+' '; //kt added 8/8/2007
159 Strings[i] := Strings[i] + U + Prefix + Copy(Strings[i], 1, 2) + ':' + Copy(Strings[i], 3, 2);
160 end;
161 end;
162end;
163
164end.
Note: See TracBrowser for help on using the repository browser.