source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/rODAllergy.pas@ 453

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

Initial upload of TMG-CPRS 1.0.26.69
File size: 12.3 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit rODAllergy;
3
4{$O-}
5
6interface
7
8uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, TRPCB, dialogs, rMisc
9 ,DkLang //kt
10 ;
11
12type
13 TAllergyRec = record
14 Changed: boolean;
15 IEN: Integer;
16 CausativeAgent: string;
17 AllergyType: string;
18 NatureOfReaction: string;
19 SignsSymptoms: TStringList;
20 Originator: int64;
21 OriginatorName: string;
22 Originated: TFMDateTime;
23 Comments: TStringList;
24 IDBandMarked: TStringList;
25 ChartMarked: TStringList;
26 Verifier: int64;
27 VerifierName: string;
28 Verified: boolean;
29 VerifiedDateTime: TFMDateTime;
30 EnteredInError: boolean;
31 DateEnteredInError: TFMDateTime;
32 UserEnteringInError: int64;
33 ErrorComments: TStringList;
34 Observed_Historical: string;
35 Observations: TStringList;
36 ReactionDate: TFMDateTime;
37 Severity: string;
38 NoKnownAllergies: Boolean;
39 NewComments: TStringList;
40 end;
41
42 TARTPatchInstalled = record
43 PatchInstalled: boolean;
44 PatchChecked: boolean;
45 end;
46
47 TGMRASiteParams = record
48 MarkIDBandFlag: Boolean;
49 OriginatorCommentsRequired: Boolean;
50 ErrorCommentsEnabled: Boolean;
51 ParamsSet: Boolean;
52 end;
53
54 TARTClinUser = record
55 IsClinUser: boolean;
56 ReasonFailed: string;
57 AccessChecked: boolean;
58 end;
59
60function SearchForAllergies(StringToMatch: string): TStrings;
61function SubsetofSymptoms(const StartFrom: string; Direction: Integer): TStrings;
62function ODForAllergies: TStrings;
63function GetCWADInfo(const DFN: string): string;
64function SaveAllergy(EditRec: TAllergyRec): string;
65function LoadAllergyForEdit(AllergyIEN: integer): TAllergyRec;
66function SendARTBulletin(AFreeTextEntry: string; AComment: TStringList): string;
67function RPCEnterNKAForPatient: string;
68
69// site parameter functions
70function ARTPatchInstalled: boolean;
71function GetSiteParams: TGMRASiteParams;
72function MarkIDBand: boolean;
73function RequireOriginatorComments: boolean;
74function EnableErrorComments: boolean;
75function IsARTClinicalUser(var AMessage: string): boolean;
76
77implementation
78
79const
80 NO_YES: array[Boolean] of string = ('NO', 'YES');
81
82var
83 uARTPatchInstalled: TARTPatchInstalled;
84 uGMRASiteParams: TGMRASiteParams;
85 uARTClinUser: TARTClinUser;
86
87function ODForAllergies: TStrings;
88begin
89 CallV('ORWDAL32 DEF',[nil]);
90 Result := RPCBrokerV.Results;
91end;
92
93function SearchForAllergies(StringToMatch: string): TStrings;
94begin
95 CallV('ORWDAL32 ALLERGY MATCH',[StringToMatch]);
96 Result := RPCBrokerV.Results;
97end;
98
99function SubsetofSymptoms(const StartFrom: string; Direction: Integer): TStrings;
100begin
101 Callv('ORWDAL32 SYMPTOMS',[StartFrom, Direction]);
102 Result := RPCBrokerV.Results;
103end;
104
105function GetCWADInfo(const DFN: string): string;
106begin
107 Result := sCallV('ORWPT CWAD',[DFN]);
108end;
109
110function LoadAllergyForEdit(AllergyIEN: integer): TAllergyRec;
111var
112 Dest: TStringList;
113 EditRec: TAllergyRec;
114 x: string;
115begin
116 Dest := TStringList.Create;
117 try
118 tCallV(Dest, 'ORWDAL32 LOAD FOR EDIT', [AllergyIEN]) ;
119 if Piece(RPCBrokerV.Results[0], U, 1) <> '-1' then
120 begin
121 with EditRec do
122 begin
123 Changed := False;
124 IEN := AllergyIEN;
125 CausativeAgent := ExtractDefault(Dest, 'CAUSATIVE AGENT');
126 AllergyType := ExtractDefault(Dest, 'ALLERGY TYPE');
127 NatureOfReaction := ExtractDefault(Dest, 'NATURE OF REACTION');
128 SignsSymptoms := TStringList.Create;
129 ExtractItems(SignsSymptoms, Dest, 'SIGN/SYMPTOMS');
130 MixedCaseByPiece(SignsSymptoms, U, 4);
131 x := ExtractDefault(Dest, 'ORIGINATOR');
132 Originator := StrToInt64Def(Piece(x, U, 1), 0);
133 OriginatorName := Piece(x, U, 2);
134 Originated := StrToFMDateTime(ExtractDefault(Dest, 'ORIGINATED'));
135 Comments := TStringList.Create;
136 ExtractText(Comments, Dest, 'COMMENTS');
137 IDBandMarked := TStringList.Create;
138 ExtractItems(IDBandMarked, Dest, 'ID BAND MARKED');
139 ChartMarked := TStringList.Create;
140 ExtractItems(ChartMarked, Dest, 'CHART MARKED');
141 //x := ExtractDefault(Dest, 'VERIFIER');
142 //Verifier := StrToInt64Def(Piece(x, U, 1), 0);
143 //VerifierName := Piece(x, U, 2);
144 //x := ExtractDefault(Dest, 'VERIFIED');
145 //Verified := Piece(x, U, 1) = 'YES';
146 //if Verified then
147 // VerifiedDateTime := StrToFMDateTime(Piece(x, U, 2));
148 x := ExtractDefault(Dest, 'ENTERED IN ERROR');
149 EnteredInError := Piece(x, U, 1) = 'YES';
150 DateEnteredInError := StrToFloatDef(Piece(x, U, 2), 0);
151 UserEnteringInError := StrToInt64Def(Piece(x, U, 3), 0);
152 ErrorComments := TStringList.Create;
153 Observed_Historical := ExtractDefault(Dest, 'OBS/HIST');
154 Observations := TStringList.Create;
155 ExtractText(Observations, Dest, 'OBSERVATIONS');
156 //ReactionDate := StrToFMDateTime(Piece(ExtractDefault(Dest, 'REACTDT'), U, 3));
157 //Severity := Piece(ExtractDefault(Dest, 'SEVERITY'), U, 3);
158 NoKnownAllergies := (StrToIntDef(Piece(ExtractDefault(Dest, 'NKA'), U, 3), 0) > 0);
159 NewComments := TStringList.Create;
160 end;
161 end
162 else
163 EditRec.IEN := -1;
164 Result := EditRec;
165 finally
166 Dest.Free;
167 end;
168end;
169
170function SaveAllergy(EditRec: TAllergyRec): string;
171var
172 i: integer;
173begin
174 with RPCBrokerV, EditRec do
175 begin
176 ClearParameters := True;
177 RemoteProcedure := 'ORWDAL32 SAVE ALLERGY';
178 Param[0].PType := literal;
179 Param[0].Value := IntToStr(IEN);
180 Param[1].PType := literal;
181 Param[1].Value := Patient.DFN;
182 Param[2].PType := list;
183 with Param[2] do
184 begin
185 if NoKnownAllergies then
186 Mult['"GMRANKA"'] := NO_YES[NoKnownAllergies];
187 if CausativeAgent <> '' then
188 Mult['"GMRAGNT"'] := CausativeAgent;
189 if AllergyType <> '' then
190 Mult['"GMRATYPE"'] := AllergyType ;
191 if NatureOfReaction <> '' then
192 Mult['"GMRANATR"'] := NatureOfReaction ;
193 if Originator > 0 then
194 Mult['"GMRAORIG"'] := IntToStr(Originator);
195 if Originated > 0 then
196 Mult['"GMRAORDT"'] := FloatToStr(Originated);
197 with SignsSymptoms do if Count > 0 then
198 begin
199 Mult['"GMRASYMP",0'] := IntToStr(Count);
200 for i := 0 to Count - 1 do
201 Mult['"GMRASYMP",' + IntToStr(i+1)] := Pieces(Strings[i], U, 1, 5);
202 end;
203 //if Verified then
204 // Mult['"GMRAVER"'] := NO_YES[Verified];
205 //if Verifier > 0 then
206 // Mult['"GMRAVERF"'] := IntToStr(Verifier);
207 //if VerifiedDateTime > 0 then
208 // Mult['"GMRAVERD"'] := FloatToStr(VerifiedDateTime);
209 if EnteredInError then
210 begin
211 Mult['"GMRAERR"'] := NO_YES[EnteredInError];
212 Mult['"GMRAERRBY"'] := IntToStr(UserEnteringInError);
213 Mult['"GMRAERRDT"'] := FloatToStr(DateEnteredInError);
214 with ErrorComments do if Count > 0 then
215 begin
216 Mult['"GMRAERRCMTS",0'] := IntToStr(Count);
217 for i := 0 to Count - 1 do
218 Mult['"GMRAERRCMTS",' + IntToStr(i+1)] := Strings[i];
219 end;
220 end ;
221 with ChartMarked do if Count > 0 then
222 begin
223 Mult['"GMRACHT",0'] := IntToStr(Count);
224 for i := 0 to Count - 1 do
225 Mult['"GMRACHT",' + IntToStr(i+1)] := Strings[i];
226 end;
227 with IDBandMarked do if Count > 0 then
228 begin
229 Mult['"GMRAIDBN",0'] := IntToStr(Count);
230 for i := 0 to Count - 1 do
231 Mult['"GMRAIDBN",' + IntToStr(i+1)] := Strings[i];
232 end;
233 if Length(Observed_Historical) > 0 then
234 Mult['"GMRAOBHX"'] := Observed_Historical;
235 if ReactionDate > 0 then
236 Mult['"GMRARDT"'] := FloatToStr(ReactionDate);
237 if Length(Severity) > 0 then
238 Mult['"GMRASEVR"'] := Severity;
239 with NewComments do if Count > 0 then
240 begin
241 Mult['"GMRACMTS",0'] := IntToStr(Count);
242 for i := 0 to Count - 1 do
243 Mult['"GMRACMTS",' + IntToStr(i+1)] := Strings[i];
244 end;
245 end;
246 CallBroker;
247 Result := Results[0];
248 end;
249end;
250
251function RPCEnterNKAForPatient: string;
252begin
253 with RPCBrokerV do
254 begin
255 ClearParameters := True;
256 RemoteProcedure := 'ORWDAL32 SAVE ALLERGY';
257 Param[0].PType := literal;
258 Param[0].Value := '0';
259 Param[1].PType := literal;
260 Param[1].Value := Patient.DFN;
261 Param[2].PType := list;
262 with Param[2] do
263 Mult['"GMRANKA"'] := 'YES';
264 CallBroker;
265 Result := Results[0];
266 end;
267end;
268
269function SendARTBulletin(AFreeTextEntry: string; AComment: TStringList): string;
270var
271 i: integer;
272begin
273 with RPCBrokerV do
274 begin
275 ClearParameters := True;
276 RemoteProcedure := 'ORWDAL32 SEND BULLETIN';
277 Param[0].PType := literal;
278 Param[0].Value := User.DUZ;
279 Param[1].PType := literal;
280 Param[1].Value := Patient.DFN;
281 Param[2].PType := literal;
282 Param[2].Value := AFreeTextEntry;
283 if AComment.Count > 0 then with Param[3] do
284 begin
285 PType := list;
286 for i := 0 to AComment.Count - 1 do
287 Mult[IntToStr(Succ(i)) + ',0'] := AComment[i];
288 Mult['0'] := '^^' + IntToStr(AComment.Count);
289 end;
290 CallBroker;
291 Result := Results[0];
292 end;
293end;
294
295// Site parameter functions
296
297function ARTPatchInstalled: boolean;
298begin
299 with uARTPatchInstalled do
300 if not PatchChecked then
301 begin
302 PatchInstalled := ServerHasPatch('GMRA*4.0*21');
303 PatchChecked := True;
304 end;
305 Result := uARTPatchInstalled.PatchInstalled;
306end;
307
308function GetSiteParams: TGMRASiteParams;
309var
310 x: string;
311begin
312 with uGMRASiteParams do
313 if not ParamsSet then
314 begin
315 x := sCallV('ORWDAL32 SITE PARAMS', [nil]);
316 MarkIDBandFlag := (Piece(x, U, 5) <> '0');
317 OriginatorCommentsRequired := (Piece(x, U, 4) = '1');
318 ErrorCommentsEnabled := (Piece(x, U, 11) = '1');
319 ParamsSet := True;
320 end;
321 Result := uGMRASiteParams;
322end;
323
324function MarkIDBand: boolean;
325begin
326 Result := GetSiteParams.MarkIDBandFlag;
327end;
328
329function RequireOriginatorComments: boolean;
330begin
331 Result := GetSiteParams.OriginatorCommentsRequired;
332end;
333
334function EnableErrorComments: boolean;
335begin
336 Result := GetSiteParams.ErrorCommentsEnabled;
337end;
338
339(*function IsARTClinicalUser(var AMessage: string): boolean;
340const
341 TX_NO_AUTH = 'You are not authorized to perform this action.' + CRLF +
342 'Either the ORES or ORELSE key is required.';
343begin
344 Result := (User.UserClass > UC_CLERK); // User has ORES or ORELSE key
345 if not Result then AMessage := TX_NO_AUTH else AMessage := '';
346end;*)
347
348function IsARTClinicalUser(var AMessage: string): boolean;
349//const
350//TX_NO_AUTH = 'You are not authorized to perform this action.' + CRLF; <-- original line. //kt 8/8/2007
351var
352 x: string;
353 TX_NO_AUTH : string; //kt
354begin
355 TX_NO_AUTH := DKLangConstW('rODAllergy_You_are_not_authorized_to_perform_this_actionx') + CRLF;
356 with uARTClinUser do
357 begin
358 if not AccessChecked then
359 begin
360 x := sCallV('ORWDAL32 CLINUSER',[nil]);
361 IsClinUser := (Piece(x, U, 1) = '1');
362 if not IsClinUser then ReasonFailed := TX_NO_AUTH + Piece(x, U, 2) else ReasonFailed := '';
363 AccessChecked := True;
364 end;
365 Result := IsClinUser;
366 AMessage := ReasonFailed ;
367 end;
368end;
369
370end.
Note: See TracBrowser for help on using the repository browser.