| [456] | 1 | unit fODAuto; | 
|---|
|  | 2 |  | 
|---|
|  | 3 | interface | 
|---|
|  | 4 |  | 
|---|
|  | 5 | uses | 
|---|
|  | 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, | 
|---|
| [829] | 7 | fODBase, StdCtrls, ComCtrls, ExtCtrls, ORFn, ORCtrls, | 
|---|
|  | 8 | VA508AccessibilityManager; | 
|---|
| [456] | 9 |  | 
|---|
|  | 10 | type | 
|---|
|  | 11 | TfrmODAuto = class(TfrmODBase) | 
|---|
|  | 12 | Label1: TLabel; | 
|---|
|  | 13 | public | 
|---|
|  | 14 | procedure InitDialog; override; | 
|---|
|  | 15 | procedure SetupDialog(OrderAction: Integer; const ID: string); override; | 
|---|
|  | 16 | procedure Validate(var AnErrMsg: string); override; | 
|---|
|  | 17 | end; | 
|---|
|  | 18 |  | 
|---|
|  | 19 | var | 
|---|
|  | 20 | frmODAuto: TfrmODAuto; | 
|---|
|  | 21 |  | 
|---|
|  | 22 | implementation | 
|---|
|  | 23 |  | 
|---|
|  | 24 | {$R *.DFM} | 
|---|
|  | 25 |  | 
|---|
|  | 26 | uses rODBase, rOrders, fTemplateDialog, uTemplateFields, rTemplates, uConst, uTemplates, | 
|---|
|  | 27 | rConsults, uCore, uODBase; | 
|---|
|  | 28 |  | 
|---|
|  | 29 | procedure TfrmODAuto.InitDialog; | 
|---|
|  | 30 | begin | 
|---|
|  | 31 | inherited; | 
|---|
|  | 32 | // nothing for now | 
|---|
|  | 33 | end; | 
|---|
|  | 34 |  | 
|---|
|  | 35 | procedure TfrmODAuto.Validate(var AnErrMsg: string); | 
|---|
|  | 36 | var | 
|---|
|  | 37 | cptn, tmp, DocInfo: string; | 
|---|
|  | 38 | TempSL: TStringList; | 
|---|
|  | 39 | LType: TTemplateLinkType; | 
|---|
|  | 40 | IEN: integer; | 
|---|
|  | 41 | HasObjects: boolean; | 
|---|
|  | 42 |  | 
|---|
|  | 43 | begin | 
|---|
|  | 44 | inherited; | 
|---|
|  | 45 | DocInfo := ''; | 
|---|
|  | 46 | LType := DisplayGroupToLinkType(Responses.DisplayGroup); | 
|---|
|  | 47 | tmp := Responses.EValueFor('COMMENT', 1); | 
|---|
|  | 48 | ExpandOrderObjects(tmp, HasObjects); | 
|---|
|  | 49 | Responses.OrderContainsObjects := Responses.OrderContainsObjects or HasObjects; | 
|---|
|  | 50 | if (LType <> ltNone) or HasTemplateField(tmp) then | 
|---|
|  | 51 | begin | 
|---|
|  | 52 | cptn := 'Reason for Request: ' + Responses.EValueFor('ORDERABLE', 1); | 
|---|
|  | 53 | case LType of | 
|---|
|  | 54 | ltConsult:   IEN := StrToIntDef(GetServiceIEN(Responses.IValueFor('ORDERABLE', 1)),0); | 
|---|
|  | 55 | ltProcedure: IEN := StrToIntDef(GetProcedureIEN(Responses.IValueFor('ORDERABLE', 1)),0); | 
|---|
|  | 56 | else         IEN := 0; | 
|---|
|  | 57 | end; | 
|---|
|  | 58 | if IEN <> 0 then | 
|---|
|  | 59 | ExecuteTemplateOrBoilerPlate(tmp, IEN, LType, nil, cptn, DocInfo) | 
|---|
|  | 60 | else | 
|---|
|  | 61 | CheckBoilerplate4Fields(tmp, cptn); | 
|---|
|  | 62 |  | 
|---|
|  | 63 | if tmp <> '' then | 
|---|
|  | 64 | Responses.Update('COMMENT', 1, TX_WPTYPE, tmp) | 
|---|
|  | 65 | else | 
|---|
|  | 66 | begin | 
|---|
|  | 67 | TempSL := TStringList.Create; | 
|---|
|  | 68 | try | 
|---|
|  | 69 | TempSL.Text := Responses.EValueFor('COMMENT', 1); | 
|---|
|  | 70 | Convert2LMText(TempSL); | 
|---|
|  | 71 | Responses.Update('COMMENT', 1, TX_WPTYPE, TempSL.Text); | 
|---|
|  | 72 | finally | 
|---|
|  | 73 | TempSL.Free; | 
|---|
|  | 74 | end; | 
|---|
|  | 75 | end; | 
|---|
|  | 76 | end; | 
|---|
|  | 77 | end; | 
|---|
|  | 78 |  | 
|---|
|  | 79 | procedure TfrmODAuto.SetupDialog(OrderAction: Integer; const ID: string); | 
|---|
|  | 80 | var | 
|---|
|  | 81 | DialogNames: TDialogNames; | 
|---|
|  | 82 | begin | 
|---|
|  | 83 | inherited;  // Responses is already loaded here | 
|---|
|  | 84 | AutoAccept := True; | 
|---|
|  | 85 | StatusText('Loading Dialog Definition'); | 
|---|
|  | 86 | FillerID := FillerIDForDialog(DialogIEN); | 
|---|
|  | 87 | IdentifyDialog(DialogNames, DialogIEN); | 
|---|
|  | 88 | Responses.Dialog := DialogNames.BaseName;                      // loads formatting info | 
|---|
|  | 89 | StatusText(''); | 
|---|
|  | 90 | end; | 
|---|
|  | 91 |  | 
|---|
|  | 92 | end. | 
|---|