source: cprs/trunk/CPRS-Chart/Orders/rODAllergy.pas@ 1424

Last change on this file since 1424 was 829, checked in by Kevin Toppenberg, 14 years ago

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