| 1 | unit fClinicWardMeds; | 
|---|
| 2 |  | 
|---|
| 3 | interface | 
|---|
| 4 |  | 
|---|
| 5 | uses | 
|---|
| 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, | 
|---|
| 7 | Dialogs, fAutoSz, StdCtrls, ExtCtrls, ORCtrls,ORFn, rCore, uCore, oRNet, Math; | 
|---|
| 8 |  | 
|---|
| 9 | type | 
|---|
| 10 | TfrmClinicWardMeds = class(TfrmAutoSz) | 
|---|
| 11 | stxtLine3: TStaticText; | 
|---|
| 12 | stxtLine2: TStaticText; | 
|---|
| 13 | stxtLine1: TStaticText; | 
|---|
| 14 | btnClinic: TButton; | 
|---|
| 15 | btnWard: TButton; | 
|---|
| 16 | procedure btnClinicClick(Sender: TObject); | 
|---|
| 17 | procedure btnWardClick(Sender: TObject); | 
|---|
| 18 |  | 
|---|
| 19 | private | 
|---|
| 20 | { Private declarations } | 
|---|
| 21 | procedure StartLocationCheck; | 
|---|
| 22 | procedure rpcChangeOrderLocation(pOrderList:TStringList); | 
|---|
| 23 | procedure BuildMessage(MsgSw:string); | 
|---|
| 24 | function  BuildOrderLocList(pOrderList:TStringList; pLocation:integer):TStringList; | 
|---|
| 25 |  | 
|---|
| 26 | public | 
|---|
| 27 | { Public declarations } | 
|---|
| 28 | // passes order list and selected locations to rpc to be saved with order. | 
|---|
| 29 | procedure ClinicOrWardLocation(pOrderList:TStringList; pEncounterLoc: integer; pEncounterLocName: string; var RetLoc: integer); overload; | 
|---|
| 30 | // returns Location selected by user. | 
|---|
| 31 | function  ClinicOrWardLocation(pEncounterLoc: integer):integer;overLoad; | 
|---|
| 32 | function  rpcIsPatientOnWard(Patient: string): boolean; | 
|---|
| 33 | function  SelectPrintLocation(pEncounterLoc:integer):integer; | 
|---|
| 34 | end; | 
|---|
| 35 |  | 
|---|
| 36 | var | 
|---|
| 37 | frmClinicWardMeds: TfrmClinicWardMeds; | 
|---|
| 38 | ALocation,AWardLoc, AClinicLoc : integer; | 
|---|
| 39 | ASelectedLoc: integer; | 
|---|
| 40 | AName, ASvc, AWardName, AClinicName: string; | 
|---|
| 41 | AOrderLocList: TStringList; | 
|---|
| 42 | AMsgSw: string; | 
|---|
| 43 |  | 
|---|
| 44 | const | 
|---|
| 45 | LOCATION_CHANGE_1 = 'This patient is currently admitted to ward'; | 
|---|
| 46 | LOCATION_CHANGE_2 = 'These orders are written at clinic'; | 
|---|
| 47 | LOCATION_CHANGE_3 = 'Where do you want the orders administered?'; | 
|---|
| 48 | //GE CQ9537  - Message text | 
|---|
| 49 | PRINT_LOCATION_1 = 'The patient has been admitted to Ward '; | 
|---|
| 50 | PRINT_LOCATION_2 =  'Should the orders be printed using the new location?'; | 
|---|
| 51 | LOC_PRINT_MSG    = 'P'; | 
|---|
| 52 | LOC_MSG          = 'L'; | 
|---|
| 53 |  | 
|---|
| 54 | implementation | 
|---|
| 55 |  | 
|---|
| 56 | uses fFrame; | 
|---|
| 57 |  | 
|---|
| 58 | {$R *.dfm} | 
|---|
| 59 |  | 
|---|
| 60 | //entry point | 
|---|
| 61 | function  TfrmClinicWardMeds.ClinicOrWardLocation(pEncounterLoc:integer):integer; | 
|---|
| 62 | begin | 
|---|
| 63 | // Patient's current location | 
|---|
| 64 | AClinicLoc  := pEncounterLoc; | 
|---|
| 65 | AClinicName := Encounter.LocationName; | 
|---|
| 66 | AMsgSw := LOC_MSG; | 
|---|
| 67 | StartLocationCheck; | 
|---|
| 68 | Result := ASelectedLoc; | 
|---|
| 69 | frmClinicWardMeds.Close; | 
|---|
| 70 | end; | 
|---|
| 71 |  | 
|---|
| 72 | //entry point | 
|---|
| 73 | procedure TfrmClinicWardMeds.ClinicOrWardLocation(pOrderList:TStringList;pEncounterLoc:integer;pEncounterLocName:string; var RetLoc: integer); | 
|---|
| 74 | begin | 
|---|
| 75 | AClinicLoc        := pEncounterLoc; | 
|---|
| 76 | AClinicName       := pEncounterLocName; | 
|---|
| 77 | AOrderLocList     := TStringList.create; | 
|---|
| 78 | AOrderLocList.Clear; | 
|---|
| 79 | AMsgSw := LOC_MSG; | 
|---|
| 80 | StartLocationCheck; | 
|---|
| 81 | if pOrderList.Count > 0 then | 
|---|
| 82 | begin | 
|---|
| 83 | rpcChangeOrderLocation(BuildOrderLocList(pOrderList, ASelectedLoc)); | 
|---|
| 84 | RetLoc := ASelectedLoc | 
|---|
| 85 | end; | 
|---|
| 86 | if Assigned(AOrderLocList) then FreeAndNil(AOrderLocList); | 
|---|
| 87 | frmClinicWardMeds.Close; | 
|---|
| 88 | end; | 
|---|
| 89 |  | 
|---|
| 90 | // returns button selected by user - ward or clinic.  print location | 
|---|
| 91 | //entry point  - | 
|---|
| 92 | function  TfrmClinicWardMeds.SelectPrintLocation(pEncounterLoc:integer):integer; | 
|---|
| 93 | begin | 
|---|
| 94 | AClinicLoc        := pEncounterLoc; | 
|---|
| 95 | AMsgSw            := LOC_PRINT_MSG; | 
|---|
| 96 | StartLocationCheck; | 
|---|
| 97 | Result := ASelectedLoc; | 
|---|
| 98 | frmClinicWardMeds.Close; | 
|---|
| 99 | end; | 
|---|
| 100 |  | 
|---|
| 101 | procedure TfrmClinicWardMeds.StartLocationCheck; | 
|---|
| 102 | begin | 
|---|
| 103 |  | 
|---|
| 104 | frmClinicWardMeds := TfrmClinicWardMeds.Create(Application); | 
|---|
| 105 | // ResizeFormToFont(TForm(frmClinicWardMeds)); | 
|---|
| 106 | CurrentLocationForPatient(Patient.DFN, ALocation, AName, ASvc); | 
|---|
| 107 | AWardLoc := ALocation; //current location | 
|---|
| 108 | AWardName := AName; // current location name | 
|---|
| 109 | if AMsgSW = LOC_PRINT_MSG then BuildMessage(AMsgSw) | 
|---|
| 110 | else | 
|---|
| 111 | if (ALocation > 0) and (ALocation <> AClinicLoc) then BuildMessage(AMsgSw); //Location has changed, patient admitted | 
|---|
| 112 | end; | 
|---|
| 113 |  | 
|---|
| 114 | procedure TfrmClinicWardMeds.btnClinicClick(Sender: TObject); | 
|---|
| 115 | begin | 
|---|
| 116 | inherited; | 
|---|
| 117 | ASelectedLoc := AClinicLoc; | 
|---|
| 118 | frmClinicWardMeds.Close; | 
|---|
| 119 | end; | 
|---|
| 120 |  | 
|---|
| 121 | procedure TfrmClinicWardMeds.btnWardClick(Sender: TObject); | 
|---|
| 122 | begin | 
|---|
| 123 | inherited; | 
|---|
| 124 | ASelectedLoc := AWardLoc; | 
|---|
| 125 | frmClinicWardMeds.Close; | 
|---|
| 126 | end; | 
|---|
| 127 |  | 
|---|
| 128 | procedure TfrmClinicWardMeds.BuildMessage(MsgSw:string); | 
|---|
| 129 | var | 
|---|
| 130 | ALine1Len, ALine2Len, ALine3Len, ALongLine: integer; | 
|---|
| 131 | begin | 
|---|
| 132 | with frmClinicWardMeds do | 
|---|
| 133 | begin | 
|---|
| 134 | btnWard.Caption   := 'Ward'; | 
|---|
| 135 | btnClinic.Caption := 'Clinic'; | 
|---|
| 136 | // message text | 
|---|
| 137 | if MsgSw = LOC_MSG then | 
|---|
| 138 | begin | 
|---|
| 139 | //AClinicName := 'this is my long test clinic Name'; | 
|---|
| 140 | stxtLine1.Caption := LOCATION_CHANGE_1 + ' :' + AWardName; | 
|---|
| 141 | stxtLine2.Caption := LOCATION_CHANGE_2+ ' :' + AClinicName; | 
|---|
| 142 | stxtLine3.Caption := LOCATION_CHANGE_3; | 
|---|
| 143 | end | 
|---|
| 144 | else | 
|---|
| 145 | begin | 
|---|
| 146 | stxtLine1.Caption := PRINT_LOCATION_1 + ':' + AWardName; | 
|---|
| 147 | stxtLine2.Caption := PRINT_LOCATION_2; | 
|---|
| 148 | stxtLine3.Caption := ''; | 
|---|
| 149 | end; | 
|---|
| 150 | stxtLine2.Left := stxtLine1.left; | 
|---|
| 151 | stxtLine3.Left := stxtLine1.left; | 
|---|
| 152 | ALine1Len := TextWidthByFont(frmClinicWardMeds.stxtLine1.Font.Handle, frmClinicWardMeds.stxtLine1.Caption); | 
|---|
| 153 | ALine2Len := TextWidthByFont(frmClinicWardMeds.stxtLine2.Font.Handle, frmClinicWardMeds.stxtLine2.Caption); | 
|---|
| 154 | ALine3Len := TextWidthByFont(frmClinicWardMeds.stxtLine3.Font.Handle, frmClinicWardMeds.stxtLine3.Caption)+25; | 
|---|
| 155 | ALongLine := Max(ALine1Len,ALine2Len); | 
|---|
| 156 | ALongLine := Max(ALine3Len,ALongLine); | 
|---|
| 157 | frmClinicWardMeds.Width := (ALongLine + frmClinicWardMeds.stxtLine1.Left + 15); | 
|---|
| 158 | end; | 
|---|
| 159 | frmClinicWardMeds.ShowModal; | 
|---|
| 160 | frmClinicWardMeds.Release; | 
|---|
| 161 |  | 
|---|
| 162 | end; | 
|---|
| 163 |  | 
|---|
| 164 | function  TfrmClinicWardMeds.BuildOrderLocList(pOrderList:TStringList; pLocation:integer):TStringList; | 
|---|
| 165 | var i:integer; | 
|---|
| 166 | AOrderLoc: string; | 
|---|
| 167 | begin | 
|---|
| 168 | AOrderLocList.clear; | 
|---|
| 169 | for i := 0 to pOrderList.Count -1 do | 
|---|
| 170 | begin | 
|---|
| 171 | AOrderLoc := Piece(pOrderList.Strings[i],U,1) + U + IntToStr(pLocation); | 
|---|
| 172 | AOrderLocList.Add(AOrderLoc); | 
|---|
| 173 | end; | 
|---|
| 174 | Result := AOrderLocList; //return value | 
|---|
| 175 | end; | 
|---|
| 176 |  | 
|---|
| 177 | procedure TfrmClinicWardMeds.rpcChangeOrderLocation(pOrderList:TStringList); | 
|---|
| 178 | begin | 
|---|
| 179 | // OrderIEN^Location  -- used to alter location if ward is selected. | 
|---|
| 180 |  | 
|---|
| 181 | CallV('ORWDX CHANGE',[pOrderList, Patient.DFN]); | 
|---|
| 182 | end; | 
|---|
| 183 |  | 
|---|
| 184 | function TfrmClinicWardMeds.rpcIsPatientOnWard(Patient: string): boolean; | 
|---|
| 185 | begin | 
|---|
| 186 | result := sCallV('ORWDX1 PATWARD',[Patient]) = '1'; | 
|---|
| 187 | end; | 
|---|
| 188 |  | 
|---|
| 189 |  | 
|---|
| 190 | end. | 
|---|