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".