00001 def new global shared var prog-started as log. 00002 def new global shared var u-name as char. 00003 00004 def shared var screen-title as char. 00005 00006 def shared var total-floor-no as int init 4. 00007 def shared var room-types as char extent 5. 00008 00009 def shared var res-state as char extent 4. 00010 def shared var res-state-ch as char extent 4. 00011 00012 def shared var res-state-placed as int init 1. 00013 def shared var res-state-canceled as int init 2. 00014 def shared var res-state-checked-in as int init 3. 00015 def shared var res-state-checked-out as int init 4. 00016 00017 prog-started = true. 00018 def var h-time as char. 00019 00020 form u-name view-as text 00021 screen-title view-as text 00022 h-time view-as text 00023 with frame f-main-header size 80 by 1 no-box no-underline no-labels at row 1 col 1. 00024 00025 00026 screen-title = "Room Rates". 00027 00028 def new shared var current-floor-no as int init 1. 00029 def new shared var current-room-type as int init ?. 00030 00031 def var i as int. 00032 def buffer b-rate for rate. 00033 def buffer b-rate2 for rate. 00034 def var pop-prog as log init true. 00035 00036 def temp-table t-floor field floor like room.floor. 00037 def temp-table t-room-type field type like room.type-of-room field name as char format "x(20)" label "Room Type". 00038 00039 do i = 1 to total-floor-no transaction: 00040 create t-floor. 00041 t-floor.floor = i. 00042 end. 00043 00044 do i = 1 to extent(room-types) transaction: 00045 create t-room-type. 00046 t-room-type.type = i. 00047 t-room-type.name = room-types[i]. 00048 end. 00049 00050 00051 def var r-rate like rate.rate. 00052 def var r-s-date like rate.start-date. 00053 def var r-e-date like rate.end-date. 00054 00055 form t-floor.floor skip 00056 t-room-type.name skip 00057 r-s-date skip 00058 r-e-date validate (r-e-date <> ? and r-e-date >= r-s-date:input-value, "End date must be after start date!") 00059 skip 00060 r-rate skip 00061 with frame f-u-rate 00062 view-as dialog-box 00063 title "Enter rate interval" 00064 centered side-labels. 00065 00066 def query q-room for t-floor, t-room-type, rate. 00067 00068 def browse brws query q-room 00069 display t-floor.floor 00070 t-room-type.name 00071 rate.start-date 00072 rate.end-date 00073 rate.rate format "$>>>,>>9.99" 00074 with 16 down. 00075 00076 form brws with frame f-rates size 80 by 20 at row 2 col 1 no-box. 00077 00078 procedure refresh. 00079 if u-name = ? or u-name = "" then do: 00080 message "You are not logged in - access denied" view-as alert-box. 00081 quit. 00082 end. 00083 00084 h-time = string(now, "99/99/99 HH:MM:SS"). 00085 h-time = substring(h-time, 10). 00086 00087 do with frame f-main-header: 00088 u-name:column = 1. 00089 screen-title:column = u-name:column + length(u-name) + (frame f-main-header:width-chars - length(u-name) - length(screen-title) - length(h-time)) / 2. 00090 h-time:column = frame f-main-header:width-chars - length(h-time). 00091 screen-title:format = "x(" + string(length(screen-title)) + ")". 00092 end. 00093 00094 display u-name screen-title h-time with frame f-main-header. 00095 00096 00097 browse brws:title = (if current-floor-no = ? then "All Floors" else "Floor " + string(current-floor-no)) + 00098 " - " + (if current-room-type = ? then "All Room Types" else room-types[current-room-type]). 00099 00100 open query q-room 00101 for each t-floor where (if current-floor-no = ? then true else t-floor.floor = current-floor-no), 00102 each t-room-type where (if current-room-type = ? then true else t-room-type.type = current-room-type), 00103 each rate where rate.floor = t-floor.floor and 00104 rate.type-of-room = t-room-type.type 00105 outer-join 00106 use-index idx-rate-e-date. 00107 /* 00108 def var q-row as int. 00109 q-row = current-result-row(query q-room). 00110 00111 reposition q-room row q-row. 00112 */ 00113 display brws with frame f-rates. 00114 brws:refresh(). 00115 00116 hide message no-pause. 00117 message "(A)dd (C)hange (S)et Floor Set Room (T)ype". 00118 message "Cop(Y) to Floor (O)utput (R)eturn". 00119 end. 00120 00121 on "y", "Y" anywhere do: 00122 def var f-from as int label "From Floor" format "9". 00123 def var f-to as int label "To Floor" format "9". 00124 00125 f-from = current-floor-no. 00126 f-to = 1. 00127 00128 form f-from skip 00129 f-to 00130 with frame f-copy side-labels title "Copy Rates" centered overlay row 5. 00131 00132 repeat on endkey undo, leave on error undo, leave transaction: 00133 update f-from f-to validate(f-to <> f-from, "Floors must be different!") with frame f-copy. 00134 00135 if f-from = ? or 00136 f-to = ? or 00137 not(f-from >= 1 and f-from <= total-floor-no) or 00138 not(f-to >= 1 and f-to <= total-floor-no) 00139 then undo, next. 00140 00141 for each b-rate where b-rate.floor = f-to: 00142 delete b-rate. 00143 end. 00144 00145 for each b-rate where b-rate.floor = f-from: 00146 create b-rate2. 00147 buffer-copy b-rate to b-rate2. 00148 b-rate2.floor = f-to. 00149 end. 00150 00151 message "Copied all rates from floor" f-from "to floor" f-to view-as alert-box. 00152 00153 leave. 00154 end. 00155 00156 hide frame f-copy no-pause. 00157 00158 run refresh. 00159 end. 00160 00161 on "a", "A" anywhere do: 00162 do transaction on endkey undo, leave: 00163 /* find last rate after which to add */ 00164 find last b-rate 00165 where b-rate.floor = rate.floor and 00166 b-rate.type-of-room = rate.type-of-room 00167 use-index idx-rate-s-date no-lock no-error. 00168 00169 if avail b-rate then do: 00170 r-rate = b-rate.rate. 00171 r-s-date = b-rate.end-date + 1. 00172 r-e-date = ?. 00173 00174 display t-floor.floor t-room-type.name r-s-date r-e-date r-rate with frame f-u-rate. 00175 00176 update r-e-date r-rate with frame f-u-rate. 00177 end. 00178 else do: 00179 r-s-date = today. 00180 r-rate = 0. 00181 00182 display t-floor.floor t-room-type.name r-s-date r-e-date r-rate with frame f-u-rate. 00183 00184 update r-s-date r-e-date r-rate with frame f-u-rate. 00185 end. 00186 00187 create b-rate. 00188 b-rate.floor = t-floor.floor. 00189 b-rate.type-of-room = t-room-type.type. 00190 b-rate.rate = r-rate. 00191 b-rate.start-date = r-s-date. 00192 b-rate.end-date = r-e-date. 00193 release b-rate. 00194 end. 00195 00196 run refresh. 00197 end. 00198 00199 on "c", "C" anywhere do: 00200 if not avail(rate) then do: 00201 message "Add a rate for this floor and room-type before changing!" view-as alert-box. 00202 run refresh. 00203 return. 00204 end. 00205 00206 if rate.end-date < today 00207 then do: 00208 message "Can not modify a rate in the past!". 00209 run refresh. 00210 return. 00211 end. 00212 00213 do transaction on endkey undo, leave: 00214 r-s-date = (if rate.start-date >= today then rate.start-date else today). 00215 r-e-date = rate.end-date. 00216 r-rate = rate.rate. 00217 00218 display t-floor.floor t-room-type.name r-s-date r-e-date r-rate with frame f-u-rate. 00219 00220 update r-rate with frame f-u-rate. 00221 00222 /* check if rate changed */ 00223 if r-rate = rate.rate then do: run refresh. return. end. 00224 00225 find b-rate where recid(b-rate) = recid(rate) exclusive-lock. 00226 00227 if rate.start-date >= today then do: 00228 b-rate.rate = r-rate. 00229 end. 00230 else do: 00231 b-rate.end-date = r-s-date - 1. 00232 00233 create b-rate. 00234 b-rate.floor = rate.floor. 00235 b-rate.type-of-room = rate.type-of-room. 00236 b-rate.rate = r-rate. 00237 b-rate.start-date = r-s-date. 00238 b-rate.end-date = r-e-date. 00239 end. 00240 00241 release b-rate. 00242 end. 00243 00244 run refresh. 00245 end. 00246 00247 on "s", "S" anywhere do: 00248 do on endkey undo, leave: 00249 def var floor-no as int. 00250 floor-no = current-floor-no. 00251 update floor-no label "Floor number" validate(floor-no >= 1 and floor-no <= total-floor-no, "Floor number must be between 1 and " + string(total-floor-no)) 00252 with frame f-floor-no overlay centered side-labels title "Set Floor Number". 00253 hide frame f-floor-no no-pause. 00254 current-floor-no = floor-no. 00255 end. 00256 run refresh. 00257 end. 00258 00259 on "t", "T" anywhere do: 00260 do on endkey undo, leave: 00261 def var r-type as int. 00262 r-type = current-room-type. 00263 form r-type label "Room type" view-as combo-box inner-lines 5 00264 with frame f-room-type overlay centered side-labels title "Set Room Type". 00265 00266 run set-room-types-combo (input r-type:handle in frame f-room-type). 00267 00268 update r-type with frame f-room-type. 00269 00270 hide frame f-room-type no-pause. 00271 current-room-type = r-type. 00272 end. 00273 current-floor-no = ?. 00274 run refresh. 00275 end. 00276 00277 on "o", "O" anywhere do: 00278 publish "push-program" ("rates-report.p"). 00279 pop-prog = false. 00280 apply "r" to frame f-rates. 00281 end. 00282 00283 run refresh. 00284 00285 enable brws with frame f-rates. 00286 00287 do on endkey undo, leave: 00288 wait-for "r", "R" of frame f-rates. 00289 end. 00290 00291 if pop-prog then publish "pop-program".