home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a067 / 1.img / GRUMP501.EXE / POPDATE.PRG < prev    next >
Encoding:
Text File  |  1991-07-19  |  43.6 KB  |  1,394 lines
  1. /*
  2.    Program: POPDATE.PRG
  3.    System: GRUMPFISH LIBRARY
  4.    Author: Greg Lief
  5.    Copyright (c) 1988-90, Greg Lief
  6.    Clipper 5.01 version
  7.    Compile instructions: clipper popdate /n/w/a
  8.               with special thanks to:
  9.               - TOM WALDEN for the multiple user time blocks,
  10.                 weekly summary, and smashing weekly report
  11.               - BOB SUMMERS for the text search and jump-to-
  12.                 current-date ideas
  13.  
  14.  
  15.    Procs & Fncts: VIEWAPPTS()
  16.                 : LOCK_APPT()
  17.                 : APPT_MAINT()
  18.                 : APPT_RECUR()
  19.                 : APPT_NOTES()
  20.                 : GETDATE()
  21.                 : APPT_CDATE()
  22.                 : APPT_SHOW()
  23.                 : GRAB_DATES()
  24.                 : APPT_DAY()
  25.                 : APPT_WEEK()
  26.                 : NOCONFLICT()
  27.                 : APPTPRINTW()
  28.                 : APPT_HEADW()
  29.                 : APPTPRINTD()
  30.                 : APPT_HEADD()
  31.                 : APPT_MEET()
  32.                 : APPT_DOM()
  33.  
  34.            Calls: CALENDBOX()    (function  in $CALENDA.PRG)
  35.                 : NEXTMONTH()    (function  in $CALENDA.PRG)
  36.  
  37.             Uses: APPT.DBF
  38.  
  39.                  1  USERID       Character     8
  40.                  2  DATE         Date          8
  41.                  3  TIME         Character     5
  42.                  4  ENDTIME      Character     5
  43.                  5  BRIEF        Character    50
  44.                  6  COMMENTS     Memo         10
  45.  
  46.         Indexes: APPTUSER.NTX (key: USERID + DTOS(DATE) + TIME)
  47.                  APPTDATE.NTX (key: DTOS(DATE) + USERID + TIME)
  48. */
  49.  
  50. //───── begin preprocessor directives
  51.  
  52. #include "grump.ch"
  53. #include "inkey.ch"
  54.  
  55. //───── end preprocessor directives
  56.  
  57. //───── begin global declarations
  58.  
  59. static winbuff            // buffer under appointment window
  60. static tdate              // current highlighted date
  61.  
  62. #define STARTDATE       dates_[1]
  63. #define ENDDATE         dates_[2]
  64. #define CURRENTYEAR     substr(dtos(mdate), 1, 4)
  65. #define CURRENTDAY      substr(dtos(mdate), 7)
  66.  
  67.  
  68. //───── end global declarations
  69.  
  70. function popdate(gfproc, gfline, gfvar)
  71. local hotkey := 0, maincolor := ColorSet(C_CALENDAR, .T.), mdate, ;
  72.       mtop := 0, mleft := 7, wk_area := select(), oldsoftseek, ;
  73.       olddelete := set(_SET_DELETED, .T.), mfile, datecoords, getlist := {}, ;
  74.       oldscore := set(_SET_SCOREBOARD, .F.), finds_ := {}, redraw, keypress, ;
  75.       newrow, newcol, tempdate, buffer, xx, mstring, mtype, dates_, numappts
  76. memvar apptdir // global that may have been declared in calling program
  77. GFSaveEnv(.t., 0)
  78.  
  79. //───── determine whether this was called via hot-key; if so, disable it
  80. if (gfproc != NIL)
  81.    setkey(hotkey := lastkey(), NIL)
  82. endif
  83.  
  84. //───── if monochrome monitor, clear the entire screen for clarity
  85. if ! iscolor()
  86.    cls
  87. endif
  88. winbuff := savescreen(15, 02, 24, 79)   && buffer underneath appt window
  89. mdate := date()
  90.  
  91. //───── open appt.dbf... first determine path, then confirm existence of file
  92. mfile := if(type('apptdir') = 'U', '', apptdir + '\') + 'appt'
  93. if ! file(mfile + '.dbf')
  94.    waiton('initializing appointment database... please wait')
  95.    dbcreate(mfile + ".dbf", { {"USERID",  "C",  8, 0} , ;
  96.                               {"DATE",    "D",  8, 0} , ;
  97.                               {"TIME",    "C",  5, 0} , ;
  98.                               {"ENDTIME", "C",  5, 0} , ;
  99.                               {"BRIEF",   "C", 50, 0} , ;
  100.                               {"COMMENTS","M", 10, 0} } )
  101.    waitoff()
  102. endif
  103. if ! file(mfile + 'user.ntx') .or. ! file(mfile + 'date.ntx')
  104.    use (mfile) new exclusive
  105.    index on appt->userid + dtos(appt->date) + appt->time to (mfile + 'user')
  106.    index on dtos(appt->date) + appt->userid + appt->time to (mfile + 'date')
  107.    use
  108. endif
  109. use (mfile) new index (mfile + 'date'), (mfile + 'user')
  110.  
  111. //───── initial screen setup
  112. ColorSet(C_CALENDAR)
  113. ShadowBox(0, 39, 12, 72, 4)
  114.  
  115. //───── draw menu options box
  116. @ 1,       45 ssay 'move by day'
  117. @ 1,       61 ssay 'by week'
  118. @ row()+1, 51 ssay 'move by month'
  119. @ row()+1, 51 ssay 'first/last day'
  120. @ row()+1, 45 ssay 'add/edit'
  121. @ row(),   62 ssay 'exit'
  122. @ row()+1, 45 ssay 'search for text'
  123. @ row()+1, 45 ssay 'print appointments'
  124. @ row()+1, 45 ssay 'delete appointments'
  125. @ row()+1, 45 ssay 'daily time blocks'
  126. @ row()+1, 45 ssay 'weekly appt summary'
  127. //───── a future enhancement made possible by dynamically sizeable arrays
  128. *@ row()+1, 45 ssay 'schedule a meeting'
  129. @ row()+1, 45 ssay 'current date: ' + dtoc(mdate)
  130. @ 0,46 ssay ' Calendar Options ' color '+' + setcolor()
  131. setcolor('I')
  132. @ 1,       41 ssay chr(27) + chr(26)
  133. @ row(),   58 ssay chr(24) + chr(25)
  134. @ row()+1, 41 ssay 'PgUp/PgDn'
  135. @ row()+1, 41 ssay 'Home/End'
  136. @ row()+1, 41 ssay chr(17) + chr(217)
  137. @ row(),   58 ssay 'Esc'
  138. @ row()+1, 41 ssay 'S'
  139. @ row()+1, 41 ssay 'P'
  140. @ row()+1, 41 ssay 'D'
  141. @ row()+1, 41 ssay 'T'
  142. @ row()+1, 41 ssay 'W'
  143. //───── a future enhancement made possible by dynamically sizeable arrays
  144. *@ row()+1, 41 ssay 'M'
  145. @ row()+1, 41 ssay 'C'
  146.  
  147. datecoords := calendbox(.t., mtop, mleft, date(), maincolor, .t.)
  148.  
  149. //───── commence main keypress loop
  150. do while .t.
  151.    redraw := .f.
  152.    tdate := mdate                  && store highlighted date
  153.    Appt_Show(CURRENTAPPTS)
  154.    keypress := ginkey(0)
  155.    newrow := CURRENTDAY_ROW
  156.    newcol := CURRENTDAY_COL
  157.    do case
  158.  
  159.    case keypress == K_DOWN .or. keypress == K_UP   // forward/backward one week
  160.       mdate += if(keypress == 24, 7, -7)
  161.       newrow += if(keypress == 24, 1, -1)
  162.  
  163.    case keypress == K_LEFT         // go back one day
  164.       mdate--
  165.       //───── did we just go from sunday to saturday??
  166.       newrow := if(dow(mdate) = 7, CURRENTDAY_ROW - 1, CURRENTDAY_ROW)
  167.       newcol := if(dow(mdate) = 7, mleft + 19, CURRENTDAY_COL - 3)
  168.  
  169.    case keypress == K_RIGHT       // go forward one day
  170.       mdate++
  171.       //───── did we just go from saturday to sunday??
  172.       newrow := if(dow(mdate) = 1, CURRENTDAY_ROW + 1, CURRENTDAY_ROW)
  173.       newcol := if(dow(mdate) = 1, mleft + 1, CURRENTDAY_COL + 3)
  174.  
  175.    case keypress == K_PGUP        // go back one month
  176.       if month(mdate) = 1     // going to december of previous year
  177.          mdate := stod( str(val(CURRENTYEAR)-1, 4) + '12' + CURRENTDAY)
  178.       else
  179.          //───── check for validity of current date in previous month
  180.          //───── i.e., cannot go from march 31 to february 31, etcetera
  181.          tempdate := ctod('')
  182.          do while empty(tempdate)
  183.             tempdate := stod(CURRENTYEAR + if(month(mdate) < 11, '0', '') + ;
  184.                         ltrim(str(month(mdate) - 1)) + CURRENTDAY)
  185.             mdate--
  186.          enddo
  187.          mdate := tempdate
  188.       endif
  189.  
  190.    case keypress == K_PGDN        // go forward one month
  191.       mdate := NextMonth(mdate)
  192.  
  193.    case keypress == K_HOME        // go to first day
  194.       newrow := FIRSTDAY_ROW
  195.       newcol := FIRSTDAY_COL
  196.       mdate := stod(substr(dtos(mdate), 1, 6) + '01')
  197.  
  198.    case keypress == K_END         // go to last day
  199.       newrow := LASTDAY_ROW
  200.       newcol := LASTDAY_COL
  201.       mdate := stod(substr(dtos(mdate), 1, 6) + str(LASTDAY_NUMBER, 2))
  202.  
  203.    case keypress == K_ENTER        // view appointments
  204.       redraw := ViewAppts(! CURRENTAPPTS)
  205.  
  206.    case keypress == 115 .or. keypress == 83      // text search
  207.       asize(finds_, 0)
  208.       mtype := Alert("What would you like to search?", ;
  209.                { "Who", "Description", "Notes" })
  210.       if lastkey() != K_ESC
  211.          xx := 0
  212.          mstring := space(20)
  213.          ColorSet(C_MESSAGE)
  214.          buffer := shadowbox(11, 18, 13, 61, 2)
  215.          @ 12, 20 ssay "Text to search for:"
  216.          @ row(), col() + 1 get mstring
  217.          setcursor(1)
  218.          read
  219.          setcursor(0)
  220.          ByeByeBox(buffer)
  221.          if lastkey() != K_ESC .and. ! empty(mstring)
  222.             mstring := trim(mstring)
  223.             go top
  224.             locate for upper(mstring) $ ;
  225.                     upper({ appt->userid, appt->brief, appt->comments }[mtype])
  226.             do while found() .and. xx < 12   // max of 12 finds for now
  227.                aadd(finds_, dtoc(appt->date) + [  ] + appt->time + [ - ] + ;
  228.                             appt->endtime + [ ] + appt->brief + str(recno(), 6))
  229.                xx++
  230.                continue
  231.             enddo
  232.             if xx > 0
  233.                ColorSet(C_ERRORMESSAGE)
  234.                buffer := shadowbox(06, 2, 19, 78, 2, ;
  235.                          'Finds for "' + mstring + '"')
  236.                xx := achoice(07, 3, 18, 77, finds_)
  237.                ByeByeBox(buffer)
  238.                if xx > 0
  239.                   mdate := ctod(substr(finds_[xx], 1, 8))
  240.                   redraw := .t.    && gotta redo the calendar screen
  241.                   //───── if we searched through notes, ask if they want to view 'em
  242.                   if mtype == 3
  243.                      if Yes_No("View these notes now")
  244.                         go val(substr(finds_[xx], 75))
  245.                         Appt_Notes()
  246.                      endif
  247.                   endif
  248.                endif
  249.             else
  250.                Err_Msg('No finds for "' + mstring + '"')
  251.             endif
  252.          endif
  253.       endif
  254.  
  255.    case keypress == 67 .or. keypress == 99      // jump to system date
  256.       newrow := SYSTEMDATE_ROW
  257.       newcol := SYSTEMDATE_COL
  258.       mdate := date()
  259.  
  260.    case keypress == 80 .or. keypress == 112     // print appts
  261.       if reccount() = 0
  262.          Err_Msg('File is currently empty')
  263.       else
  264.          xx := Yes_No2("Print for week or selected dates", 12, ;
  265.                        " week ", " selected dates ")
  266.          if lastkey() != K_ESC
  267.             if xx
  268.                ApptPrintW()
  269.             else
  270.                dates_ := Grab_Dates('print')
  271.                if lastkey() != K_ESC
  272.                   ApptPrintD(STARTDATE, ENDDATE)
  273.                endif
  274.             endif
  275.          endif
  276.       endif
  277.  
  278.    case keypress == 68 .or. keypress == 100     // delete appts
  279.       if reccount() = 0
  280.          Err_Msg('File is currently empty')
  281.       else
  282.          dates_ := Grab_Dates('delete')
  283.          if lastkey() != K_ESC
  284.             oldsoftseek := set(_SET_SOFTSEEK, .t.)
  285.             seek dtos(STARTDATE)
  286.             if ! eof()
  287.                xx := recno()
  288.                count while appt->date >= STARTDATE .and. ;
  289.                            appt->date <= ENDDATE to numappts
  290.                if numappts > 0
  291.                   if Yes_No('You are about to delete ' + ltrim(str(numappts)) + ;
  292.                             ' appointments between ' + dtoc(STARTDATE) + ;
  293.                             ' and ' + dtoc(ENDDATE), 'Do you want to continue')
  294.                      go xx
  295.                      delete while appt->date >= STARTDATE .and. ;
  296.                                   appt->date <= ENDDATE .and. rlock()
  297.                      if appt->date <= ENDDATE .and. ! eof()
  298.                         Err_Msg('Only deleted appointments up to ' + dtoc(appt->date))
  299.                      endif
  300.                      redraw := .t.    && gotta redo the calendar screen
  301.                   endif
  302.                else
  303.                   Err_Msg('No appointments fall within the dates ' + ;
  304.                      dtoc(STARTDATE) + ' and ' + dtoc(ENDDATE))
  305.                endif
  306.             endif
  307.             set(_SET_SOFTSEEK, oldsoftseek)
  308.          endif
  309.       endif
  310.  
  311.    case keypress == 84 .or. keypress == 116     // show daily time blocks
  312.       Appt_Day()
  313.       loop
  314.  
  315.    case keypress == 87 .or. keypress == 119     // show weekly time blocks
  316.       Appt_Week()
  317.       loop
  318.  
  319.  //───── a future enhancement made possible by dynamically sizeable arrays
  320.  *  case keypress == 77 .or. keypress == 109     && m - schedule meeting
  321.  *     appt_meet()
  322.  *     loop
  323.  
  324.    case keypress == K_ESC
  325.       exit
  326.  
  327.    otherwise                  && any other keystroke
  328.       loop
  329.  
  330.    endcase
  331.    //───── if we changed months or a recurring appointment was added, redraw calendar
  332.    if month(tdate) != month(mdate) .or. redraw
  333.       datecoords := calendbox(.t., mtop, mleft, mdate, maincolor)
  334.    else
  335.       setcolor('+' + maincolor)
  336.       //───── check to see if previous date had appointments (for display purposes)
  337.       seek dtos(tdate)
  338.       if found()
  339.          setcolor('i')
  340.       endif
  341.       @ CURRENTDAY_ROW, CURRENTDAY_COL ssay str(day(tdate), 2)
  342.       //───── check to see if new date has appointments (for display purposes)
  343.       seek dtos(mdate)
  344.       CURRENTAPPTS := (found())
  345.       setcolor(if(CURRENTAPPTS, '*i', '*+' + maincolor))
  346.       @ newrow, newcol ssay str(day(mdate),2)
  347.       //───── store new row/column coordinates for highlighted date
  348.       CURRENTDAY_ROW := newrow
  349.       CURRENTDAY_COL := newcol
  350.    endif
  351. enddo
  352. //───── clean up
  353. use
  354. select(wk_area)
  355.  
  356. //───── restore hot-key
  357. if hotkey != 0
  358.    setkey( hotkey, {|p, l, v| popdate(p, l, v)} )
  359. endif
  360. set(_SET_SCOREBOARD, oldscore)    // in case you were keeping SCORE
  361. set(_SET_DELETED, olddelete)
  362. GFRestEnv()
  363. return NIL
  364.  
  365. * end function PopDate()
  366. *--------------------------------------------------------------------*
  367.  
  368.  
  369. /*
  370.    Function:  VIEWAPPTS
  371. */
  372. static function viewappts(newday)
  373. local browse, column, buffer_[3], key, mtime, mendtime, mdate, ;
  374.       ele := 1, ret_val := .f., getlist := {}
  375. restscreen(15, 02, 24, 79, winbuff) // remove daily appt window first
  376. seek dtos(tdate)
  377. buffer_[1] := savescreen(22, 00, 24, 79)
  378. browse := TBrowseDB( 16, 3, 19, 75 )
  379. browse:headSep := "═"
  380. *browse:colSep  := "│"
  381. browse:colorSpec := ColorSet(C_APPOINTMENT, .T.) + ',' + "+W/N"
  382. browse:skipBlock := { |SkipCnt| AwSkipIt(SkipCnt) }
  383. column := TBColumnNew( "Who", fieldblock( "USERID" ) )
  384. browse:addColumn(column)
  385. column := TBColumnNew( "Start", fieldblock( "TIME" ) )
  386. browse:addColumn(column)
  387. column := TBColumnNew( "End", fieldblock( "ENDTIME" ) )
  388. browse:addColumn(column)
  389. column := TBColumnNew( "Appointment Description", { || field->BRIEF + ;
  390.           if(len(trim(field->comments)) > 2, chr(251), chr(32)) } )
  391. browse:addColumn(column)
  392. ColorSet(C_CALENDAR)
  393. scroll(22, 00, 24, 79, 0)
  394. @ 24,05 ssay "add"
  395. @ 24,13 ssay "edit"
  396. @ 24,22 ssay "delete"
  397. @ 24,33 ssay "move"
  398. @ 24,42 ssay "recurring appt"
  399. @ 24,61 ssay "notes"
  400. @ 24,73 ssay "exit"
  401. setcolor('I')
  402. @ 24, 3 ssay "A"
  403. @ 24,11 ssay "E"
  404. @ 24,20 ssay "D"
  405. @ 24,31 ssay "M"
  406. @ 24,40 ssay "R"
  407. @ 24,59 ssay "N"
  408. @ 24,69 ssay "Esc"
  409. seek dtos(tdate)
  410. ColorSet(C_APPOINTMENT)
  411. buffer_[2] := ShadowBox(15, 02, 20, 76, 2)
  412. if newday
  413.    keyboard "A"              // force immediate Add mode
  414. endif
  415. do while .t.
  416.  
  417.    //───── wait for the display to stabilize, which will
  418.    //───── loop once for each row in the browse window.
  419.    //───── allow a keypress to bust out of this loop
  420.    do while ! browse:stabilize() .and. (key := inkey()) = 0
  421.    enddo
  422.  
  423.    if browse:stable
  424.       key := ginkey(0, "KEY")
  425.    endif
  426.  
  427.    //───── deal with the keypress
  428.    do case
  429.  
  430.       case key == K_UP
  431.          browse:up()
  432.  
  433.       case key == K_LEFT
  434.          browse:left()
  435.  
  436.       case key == K_RIGHT
  437.          browse:right()
  438.  
  439.       case key == K_DOWN
  440.          browse:down()
  441.  
  442.       case key == K_CTRL_PGUP
  443.          browse:goTop()
  444.  
  445.       case key == K_CTRL_PGDN
  446.          browse:goBottom()
  447.  
  448.       case key == K_PGUP .or. key == K_HOME
  449.          browse:pageUp()
  450.  
  451.       case key == K_PGDN .or. key == K_END
  452.          browse:pageDown()
  453.  
  454.       case key == K_ESC
  455.          //───── if we forced an exit because they deleted or moved the
  456.          //───── final appointment for this date, we must be sure to
  457.          //───── return .T. to the calling routine so that the calendar
  458.          //───── box will be redrawn
  459.          if appt->date != tdate
  460.             ret_val := .t.
  461.          endif
  462.          exit
  463.  
  464.       case key == 68 .or. key == 100             // Delete
  465.          IF Yes_No('This appointment will be deleted', 'Continue')
  466.             Lock_Appt(.T.)
  467.          ENDIF
  468.          browse:refreshAll()
  469.  
  470.       case key == 65 .or. key == 97              // Add Record
  471.          if Appt_Maint('A', .f., newday)
  472.             newday := .f.
  473.             browse:refreshAll()
  474.          endif
  475.  
  476.       case key == 77 .or. key == 109            // Move appt
  477.          ColorSet(C_MESSAGE)
  478.          mdate := ctod("")
  479.          buffer_[3] := shadowbox(21, 26, 23, 53, 2, 'Move appointment')
  480.          @ 22,28 ssay 'Enter new date:'
  481.          @ row(), col() + 1 get mdate
  482.          setcursor(1)
  483.          read
  484.          setcursor(0)
  485.          ByeByeBox(buffer_[3])
  486.          if lastkey() != K_ESC .and. ! empty(mdate)
  487.             if NoConflict("E", mdate, appt->userid, appt->time, appt->endtime, .f.)
  488.                Lock_Appt(mdate)
  489.                browse:refreshAll()
  490.             endif
  491.          endif
  492.  
  493.       case key == 69 .or. key == 101   // Edit Record
  494.          Appt_Maint('E', .F.)
  495.          browse:refreshAll()   // not just "Current" in case of network apps
  496.  
  497.       case key == 82 .or. key == 114    // Recurring appt
  498.          Appt_Maint('A', .T.)
  499.          //───── force a refresh of the calendar screen after we exit
  500.          //───── the appointment window!
  501.          ret_val := .t.
  502.          browse:refreshAll()
  503.  
  504.       case key == 78 .or. key == 110    // view notes
  505.          Appt_Notes()
  506.          if lastkey() != K_ESC
  507.             browse:refreshCurrent()
  508.          endif
  509.  
  510.    endcase
  511. enddo
  512. ByeByeBox(buffer_[2])
  513. restscreen(22, 00, 24, 79, buffer_[1])
  514. return ret_val
  515.  
  516. * end static function ViewAppts()
  517. *--------------------------------------------------------------------*
  518.  
  519.  
  520. /*
  521.    Function: AwSkipIt()
  522.    Purpose:  Pseudo-filter to only show appts for highlighted day
  523. */
  524. static function awskipit(skip_cnt)
  525. local movement := 0
  526. do case
  527.    case skip_cnt == 0
  528.       skip 0
  529.  
  530.    case skip_cnt > 0
  531.       do while movement < skip_cnt .and. appt->date <= tdate
  532.          skip 1
  533.          movement++
  534.       enddo
  535.       //───── make sure that we are on the right date - if not, back up to it
  536.       do while (appt->date > tdate .or. eof()) .and. ! bof()
  537.          skip -1
  538.          movement--
  539.       enddo
  540.       if bof() .or. appt->date != tdate   // hey!  no more appts for this date!!
  541.          keyboard chr(K_ESC)
  542.       endif
  543.  
  544.    case skip_cnt < 0
  545.       do while movement > skip_cnt .and. appt->date >= tdate
  546.          skip -1
  547.          if bof()
  548.             exit
  549.          endif
  550.          movement--
  551.       enddo
  552.       //───── make sure that we are on the right date - if not, move up to it
  553.       do while appt->date < tdate .and. ! eof()
  554.          skip
  555.          movement++
  556.       enddo
  557.       if eof() .or. appt->date != tdate   // hey!  no more appts for this date!!
  558.          keyboard chr(K_ESC)
  559.       endif
  560.  
  561. endcase
  562. return movement
  563.  
  564. * end static function AwSkipIt()
  565. *--------------------------------------------------------------------*
  566.  
  567.  
  568. /*
  569.    Function: LOCK_APPT()  -- used for moving and deleting appts
  570. */
  571. static function lock_appt(mdate)
  572. if rlock()
  573.    if valtype(mdate) = "D"
  574.       replace appt->date with mdate
  575.    else                      // kill it
  576.       delete
  577.       skip
  578.    endif
  579.    unlock
  580. else
  581.    err_msg(NETERR_MSG)
  582. endif
  583. return NIL
  584.  
  585. * end static function Lock_Appt()
  586. *--------------------------------------------------------------------*
  587.  
  588.  
  589. /*
  590.    Function: APPT_MAINT
  591. */
  592. static function Appt_Maint(mode, recur_appt, newday)
  593. local oldscrn, muserid, mtime, mendtime, mbrief, ret_val := .t., marker, ;
  594.       cur_row := row(), mstart := "  :  ", app_ok, getlist := {}
  595. gfsaveenv( { maxrow() - 2, 00, maxrow(), maxcol() } )
  596. default newday to .f.
  597. muserid  := if(mode == 'A', space(8), appt->userid)
  598. mtime    := if(mode == 'A', mstart, appt->time)
  599. mendtime := if(mode == 'A', mstart, appt->endtime)
  600. mbrief   := if(mode == 'A', space(50), appt->brief)
  601. ColorSet(C_CALENDAR)
  602. scroll(22, 00, 24, 79, 0)
  603. @ 23,24 ssay 'save edits'
  604. @ 23,44 ssay 'exit without saving'
  605. @ 23,17 ssay 'Ctrl-W' color 'I'
  606. @ 23,40 ssay 'Esc' color 'I'
  607. setcolor('+w/bg,i')
  608. oldscrn := shadowbox(cur_row - 1, 1, cur_row + 1, maxcol() - 2, 4)
  609. @ cur_row,  3 get muserid picture '@!' valid ! empty(muserid)
  610. @ cur_row,  12 get mtime picture '##:##' ;
  611.       valid val(substr(mtime,1,2)) < 24 .and. val(substr(mtime,4)) < 60
  612. @ cur_row, 18 get mendtime picture '##:##' valid mendtime == mstart .or. ;
  613.       (val(substr(mendtime,1,2)) < 24 .and. val(substr(mendtime,4)) < 60 .and. ;
  614.       mendtime >= mtime) .or. lastkey() == K_UP
  615. @ cur_row, 24 get mbrief
  616. setcursor(1)
  617. read
  618. setcursor(0)
  619. if (lastkey() != K_ESC .and. (val(mtime)>0 .or. ! empty(mbrief))) .and. ;
  620.                          noconflict(mode, tdate, muserid, mtime, mendtime, .f.)
  621.    if recur_appt
  622.       marker := recno()
  623.       appt_recur(muserid, mtime, mendtime, mbrief)
  624.    else
  625.       if mode == 'A'      // adding record
  626.          append blank
  627.          app_ok := ! neterr()
  628.       else
  629.          app_ok := rlock()
  630.       endif
  631.       if app_ok
  632.          //───── note that if user left ending time blank, we will replace it
  633.          //───── with the starting time
  634.          replace appt->date with tdate, appt->time with mtime, ;
  635.                  appt->brief with mbrief, ;
  636.                  appt->endtime with if(mendtime == mstart, mtime, mendtime), ;
  637.                  appt->userid with muserid
  638.       else
  639.          err_msg(NETERR_MSG)
  640.       endif
  641.       unlock
  642.    endif
  643. elseif newday
  644.    //───── what this means is that either the user escaped without adding an
  645.    //───── appt for a new day -- we must then bust out back to the calendar
  646.    //───── window upon returning to the TBROWSE() section above
  647.    ret_val := ! newday
  648.    if ! ret_val
  649.       keyboard chr(K_ESC)
  650.    endif
  651. endif
  652. byebyebox(oldscrn)
  653. gfrestenv()
  654. return ret_val
  655.  
  656. * end static function Appt_Maint()
  657. *--------------------------------------------------------------------*
  658.  
  659.  
  660. /*
  661.    Function: Appt_Recur()
  662.    Calls: Appt_CDate()
  663.         : MextMonth()    (function in CALENDAR.PRG)
  664. */
  665. static function appt_recur(muserid, mtime, mendtime, mbrief)
  666. local oldscrn, oldcolor, end, start, curr_area, ;
  667.       mdom := Appt_Dom(tdate), mmonth, sel, app_ok, getlist := {}
  668. //───── we only need the 6th option if current day is, in fact, a weekday
  669. local choices := {'Every ' + gfday(tdate), ;
  670.                   'Every other ' + gfday(tdate), ;
  671.                   'Every ' + appt_cdate(day(tdate)) + ' of the month', ;
  672.                   'Every day', ;
  673.                   'Every ' + appt_cdate(mdom) + ' ' + gfday(tdate) }
  674. if dow(tdate) > 1 .and. dow(tdate) < 7
  675.    aadd(choices, 'Every weekday')
  676. endif
  677. oldcolor := setcolor('w/rb')
  678. oldscrn  := shadowbox(16, 48, 17 + len(choices), 72, 2, 'Recurring appointment')
  679. setcolor('+w/rb')
  680. sel := achoice(17, 49, 16 + len(choices), 71, choices, '', 'sel_udf')
  681. if sel > 0
  682.    clear gets
  683.    ColorSet(C_CALENDAR)
  684.    shadowbox(18, 49, 20, 71, 2)
  685.    setcolor('+' + setcolor())
  686.    end := tdate
  687.    @ 19,50 ssay 'Ending date:'
  688.    @ row(), col()+1 get end picture '@d' valid end >= tdate
  689.    setcursor(1)
  690.    read
  691.    setcursor(0)
  692.    waiton('Adding recurring appointments... please wait')
  693.    start := tdate
  694.    do while start <= end
  695.       if noconflict("A", start, muserid, mtime, mendtime, .t.)
  696.          append blank
  697.          app_ok := ! neterr()
  698.          if app_ok
  699.             replace appt->date with start, appt->time with mtime, ;
  700.                     appt->endtime with mendtime, ;
  701.                     appt->brief with mbrief, appt->userid with muserid
  702.             unlock
  703.          else
  704.             err_msg(NETERR_MSG)
  705.          endif
  706.       endif
  707.       //───── increment date by appropriate interval
  708.       do case
  709.          case sel == 1 .or. sel == 2
  710.             start += sel * 7
  711.          case sel == 3
  712.             start := nextmonth(start)
  713.          case sel == 4
  714.             start++
  715.          case sel == 5
  716.             start := nextmonth(start)
  717.             do while start <= end
  718.                //───── first determine 1st day of next month
  719.                start := stod(substr(dtos(start), 1, 6) + "01")
  720.                //───── go to the correct day of the week
  721.                do while dow(start) != dow(tdate)
  722.                   start++
  723.                enddo
  724.                //───── add the appropriate number of weeks
  725.                mmonth := cmonth(start)
  726.                start += 7 * (mdom - 1)
  727.                if cmonth(start) != mmonth
  728.                   err_msg("There is no " + appt_cdate(mdom) + " " + ;
  729.                           cdow(tdate) + " in " + mmonth)
  730.                else
  731.                   exit
  732.                endif
  733.             enddo
  734.  
  735.          case sel == 6
  736.             start += if(dow(start) < 6, 1, 3)
  737.       endcase
  738.  
  739.    enddo
  740.    waitoff()
  741. endif
  742. setcolor(oldcolor)
  743. byebyebox(oldscrn)
  744. return NIL
  745.  
  746. * end static function Appt_Recur()
  747. *--------------------------------------------------------------------*
  748.  
  749.  
  750. /*
  751.    Function: APPT_NOTES()
  752.    Calls: MEMEDIT()      (function in MEMEDIT.PRG)
  753. */
  754. static function Appt_Notes(editing)
  755. local mcomments
  756. gfsaveenv( { 16, 00, maxrow(), maxcol() }, 1, '+w/' + if(iscolor(), 'rb', 'n'))
  757. shadowbox(16, 00, maxrow(), maxcol(), 2, 'Ctrl-W to save, Esc to exit')
  758. mcomments := memoedit(appt->comments, 17, 01, maxrow()-1, maxcol()-1, .t., ;
  759.              'memo_udf')
  760. gfrestenv()
  761. if lastkey() != K_ESC
  762.    if rlock()
  763.       replace appt->comments with mcomments
  764.       unlock
  765.    else
  766.       err_msg(NETERR_MSG)
  767.    endif
  768. endif
  769. return NIL
  770.  
  771. * end static function Appt_Notes()
  772. *--------------------------------------------------------------------*
  773.  
  774.  
  775. /*
  776.    Function: MEMO_UDF()
  777. */
  778. function memo_udf(stat, line, col)
  779. local cur_row := row()
  780. if lastkey() == K_ESC
  781.    setcursor(0)
  782.    tone(MUSIC_ALERT, 1)
  783.    tone(MUSIC_ALERT, 1)
  784.    ColorSet(C_ERRORMESSAGE)
  785.    shadowbox(cur_row + 2, 29, cur_row + 4, 50, 2)
  786.    @ cur_row + 3, 31 ssay 'Notes not updated!'
  787.    inkey(2)
  788. endif
  789. return 0
  790.  
  791. * end function Memo_UDF()
  792. *--------------------------------------------------------------------*
  793.  
  794.  
  795. /*
  796.    Function: ApptPrintD()
  797.    Calls: PRINTOK()      (function in PRINTOK.PRG)
  798.         : APPT_HEAD()
  799. */
  800. static function ApptPrintD(start, end)
  801. local page := 1, xx, oldsoftseek, lines, ;
  802.       noteprint := yes_no('do you want to include comments')
  803. waiton()
  804. if printok()
  805.    appt_headd(page, start, end)
  806.    oldsoftseek := set(_SET_SOFTSEEK, .t.)
  807.    set softseek on
  808.    seek dtos(start)
  809.    set(_SET_SOFTSEEK, oldsoftseek)
  810.    do while appt->date >= start .and. appt->date <= end
  811.       if prow() > 59
  812.          appt_headd(page, start, end)
  813.       endif
  814.       if ! empty(appt->time) .or. ! empty(appt->brief)  // weed out blanks
  815.          @ prow()+2,01  say appt->userid
  816.          @ prow(),  10  say dtoc(appt->date)
  817.          @ prow(),  20  say appt->time
  818.          @ prow(),  27  say appt->endtime
  819.          @ prow(),  34  say substr(appt->brief, 1, 45)
  820.          if noteprint    // print memofield also
  821.             lines := mlcount(appt->comments, 50)
  822.             for xx := 1 to lines
  823.                if prow() > 59
  824.                   appt_headd(page, start, end)
  825.                endif
  826.                @ prow()+1, 25 say trim(memoline(appt->comments, 50, xx))
  827.             next
  828.          endif
  829.       endif
  830.       skip
  831.    enddo
  832.    eject
  833. endif
  834. set device to screen
  835. waitoff()
  836. return []
  837.  
  838. * end static function ApptPrintD()
  839. *--------------------------------------------------------------------*
  840.  
  841.  
  842. /*
  843.    Function: Appt_HeadD()
  844.    Heading for appointment report (range of dates)
  845. */
  846. static function Appt_HeadD(page, start, end)
  847. @ 0,1 say dtoc(date())
  848. CENTER(0, 'Appointments for ' + dtoc(start) + ' through ' + dtoc(end))
  849. @ 0,71 say 'page ' + ltrim(str(++page))
  850. @ prow()+2,01 say 'Who'
  851. @ prow(),  12 say 'Date'
  852. @ prow(),  20 say 'Start'
  853. @ prow(),  28 say 'End'
  854. @ prow(),  47 say 'Appointment description'
  855. @ prow()+1,01 say '---'
  856. @ prow(),  10 say replicate('-',8)
  857. @ prow(),  20 say replicate('-',5) + '  ' + replicate('-',5)
  858. @ prow(),  34 say replicate('-',45)
  859. return NIL
  860.  
  861. * end static function Appt_HeadD()
  862. *--------------------------------------------------------------------*
  863.  
  864.  
  865. /*
  866.    Function: Appt_CDate()
  867.    Returns day # and 'st, th, nd' (e.g., '2nd, 3rd...')
  868. */
  869. static function Appt_CDate(mday)
  870. local mtag, mtagstr := {'st', 'nd', 'rd'}
  871. if (mday > 3 .and. mday < 21) .or. (mday > 23 .and. mday < 31)
  872.    mtag := 'th'
  873. else
  874.    mtag := mtagstr[mday % 10]
  875. endif
  876. return ltrim(str(mday)) + mtag
  877.  
  878. * end static function Appt_CDate()
  879. *--------------------------------------------------------------------*
  880.  
  881.  
  882. /*
  883.     Function: Appt_Show()
  884.     Displays appointments for highlighted date while in calendar
  885. */
  886. static function appt_show(show_em)
  887. local appts := {}, xx, oldcolor
  888. if show_em
  889.    oldcolor := ColorSet(C_CALENDAR)
  890.    shadowbox(15, 02, 23, 77, 1, 'appointments for ' + dtoc(tdate))
  891.    seek dtos(tdate)
  892.    xx := 16
  893.    do while tdate == appt->date .and. xx < 23
  894.       @ xx++, 03 ssay appt->userid + ' ' + appt->time + ' - ' + ;
  895.                    appt->endtime + ' ' + appt->brief
  896.       skip
  897.    enddo
  898.    //───── there are more than seven appointments for this date
  899.    if tdate == appt->date
  900.       @ 23, 37 ssay ' more '
  901.    endif
  902.    setcolor(oldcolor)
  903. else
  904.    restscreen(15, 02, 24, 79, winbuff)
  905. endif
  906. return NIL
  907.  
  908. * end static function Appt_Show()
  909. *--------------------------------------------------------------------*
  910.  
  911.  
  912. /*
  913.    Function: GRAB_DATES()
  914.    Get starting and ending date for printing/deleting appts
  915. */
  916. static function Grab_Dates(msg)
  917. local buffer, dates_ := { tdate, tdate }, oldcolor, getlist := {}
  918. oldcolor := ColorSet(C_MESSAGE)
  919. buffer := shadowbox(12, 27, 15, 52, 2, msg + ' appointments')
  920. @ 13,29 ssay 'Starting date: '
  921. @ 14,29 ssay 'Ending date: '
  922. @ 13,44 get STARTDATE
  923. @ 14,44 get ENDDATE valid ENDDATE >= STARTDATE
  924. setcursor(1)
  925. read
  926. setcursor(0)
  927. ByeByeBox(buffer)
  928. return dates_
  929.  
  930. * end static function Grab_Dates()
  931. *--------------------------------------------------------------------*
  932.  
  933.  
  934. /*
  935.    Function: Appt_Day()
  936.    Displays used and available time blocks for highlighted date
  937. */
  938. static function appt_day()
  939. static times[65]
  940. local buffer, minutes, xx, yy, zz, mrec, lastuser, oldcolor, muserid
  941. afill(times, 176)
  942. seek dtos(tdate)
  943. if found()
  944.    mrec := recno()
  945.    yy   := 0
  946.    lastuser := '%^@'
  947.    do while appt->date == tdate .and. ! eof()
  948.       if lastuser != appt->userid           // employees for the array size
  949.          yy++
  950.          lastuser := appt->userid
  951.       endif
  952.       skip
  953.    enddo
  954.    goto mrec
  955.    zz := 0
  956.    oldcolor := ColorSet(C_WAITMESSAGE)
  957.    buffer := shadowbox(0, 1, 4+yy, 77, 2, 'Appointment summary for ' + ;
  958.              dtoc(tdate) + ' (' + chr(176) + chr(177) + ;
  959.              ' = available, ' + chr(219) + ' = used)')
  960.    @ 2, 11 ssay '6   7   8   9   10  11  12  1   2   3   4   5   6   7   8   9   10'
  961.    @ 3+yy, 11 ssay '6   7   8   9   10  11  12  1   2   3   4   5   6   7   8   9   10'
  962.    do while appt->date == tdate .and. ! eof()
  963.       muserid := appt->userid
  964.       zz++
  965.       //───── we will alternate between two different background characters:
  966.       //───── (ASCII 176 and 177) so that each employee's line is distinct
  967.       afill(times, 176 + (zz % 2))
  968.       do while muserid == appt->userid .and. appt->date == tdate .and. ! eof()
  969.          if val(left(appt->time, 2)) > 5 .and. ;
  970.             val(substr(appt->time, 1, 2)) < 22
  971.             xx := (val(left(appt->time, 2)) - 6) * 4 + 1 + ;
  972.                   int(val(substr(appt->time, 4)) / 15)
  973.             times[xx] := 219
  974.             //───── determine time differential (in minutes) between
  975.             //───── starting and ending times for this appointment
  976.             minutes := val(left(appt->endtime,2)) * 60 + ;
  977.                        val(substr(appt->endtime, 4)) - ;
  978.                        val(left(appt->time, 2)) * 60 - ;
  979.                        val(substr(appt->time, 4))
  980.             do while minutes > 15 .and. xx <= 64
  981.                times[++xx] := 219
  982.                minutes -= 15
  983.             enddo
  984.          endif
  985.          skip
  986.       enddo
  987.       @ 2 + zz, 2 ssay muserid
  988.       //───── use virtual windowing to make display smoother
  989.       dispbegin()
  990.       for xx = 1 to 65
  991.           @ 2 + zz, 10 + xx ssay chr(times[xx])
  992.       next
  993.       dispend()
  994.    enddo
  995.    ginkey(0)
  996.    ByeByeBox(buffer)
  997.    setcolor(oldcolor)
  998. endif
  999. return NIL
  1000.  
  1001. * end static function Appt_Day()
  1002. *--------------------------------------------------------------------*
  1003.  
  1004.  
  1005. /*
  1006.    Function: NoConflict()
  1007.    Ensure that this appt is not creating a conflict with time
  1008. */
  1009. static function noconflict(mode, mdate, muserid, start, end, recurring)
  1010. local ret_val := .t., marker := recno()
  1011. field date, userid, time, endtime
  1012. set order to 2   // make userid primary search field
  1013. go top
  1014. seek muserid + dtos(mdate)
  1015. do while mdate = date .and. userid == muserid .and. ! eof()
  1016.    if (mode = 'A' .or. marker != recno())      .and. ;
  1017.        ( (start >= time .and. start < endtime) .or.  ;
  1018.        (end > time .and. end <= endtime)       .or.  ;
  1019.        (start <= time .and. end >= endtime) )
  1020.       ret_val := .f.
  1021.       exit
  1022.    endif
  1023.    skip
  1024. enddo
  1025. set order to 1   // switch back to date as primary search field
  1026. go marker
  1027. if ! ret_val
  1028.    Err_Msg('This appointment creates a conflict' + if(recurring != NIL, ;
  1029.            ' on ' + dtoc(mdate), '') + ' and thus cannot be added')
  1030. endif
  1031. return ret_val
  1032.  
  1033. * end static function NoConflict()
  1034. *--------------------------------------------------------------------*
  1035.  
  1036.  
  1037. /*
  1038.   Function: Appt_Week()
  1039.   Displays summary of morning/afternoon appts for the next week
  1040. */
  1041. static function appt_week()
  1042. local mfile, xx, yy, zz, num_recs, pdate, ndate, mcol := 11, mrow, muserid, ;
  1043.       oldcolor, buffer1, buffer2, wk_area := select(), times_[12], ;
  1044.       mstart, mend
  1045. field userid, date, time, endtime
  1046. ColorSet(C_MESSAGE)
  1047.  
  1048. // we only want to look at this week, so reset date to monday.
  1049. // note: if we are on a weekend day, we want to look at the upcoming week
  1050. pdate := dow(tdate)
  1051. do case
  1052.    case pdate = 1
  1053.       pdate := tdate + 1
  1054.    case pdate = 7
  1055.       pdate := tdate + 2
  1056.    otherwise
  1057.       pdate := tdate - (pdate - 2)
  1058. endcase
  1059.  
  1060. mfile := randfile("appt")
  1061. copy to (mfile) for appt->date >= pdate .and. appt->date < pdate + 5
  1062. use (mfile) new exclusive
  1063. pack
  1064. if lastrec() > 0
  1065.    index on userid to (mfile) unique
  1066.    count to num_recs
  1067.    index on userid + dtos(date) + time to (mfile)
  1068.    go top
  1069.    buffer1 := shadowbox(0, 1, 3+num_recs, 77, 1, ;
  1070.               'Weekly appointment summary (' + chr(176) + chr(177) + ;
  1071.               ' = available, ' + chr(219) + ' = used)')
  1072.    ndate := pdate
  1073.    buffer2 := replicate('═',12)
  1074.  
  1075.    for xx = 0 to 4
  1076.       @ 1, mcol + (xx * 13) + 1 ssay left(cdow(ndate), 3) + ' ' + ;
  1077.                                     str(month(ndate), 2) + '/' + ;
  1078.                                     if(day(ndate) < 10, '0', '') + ;
  1079.                                     ltrim(str(day(ndate), 2))
  1080.       @ 2, mcol + (xx * 13) ssay buffer2
  1081.       ndate++
  1082.  
  1083.       if dow(ndate) = 1
  1084.          ndate++
  1085.          mcol += 2
  1086.       elseif dow(ndate) = 7
  1087.          ndate += 2
  1088.          mcol += 2
  1089.       endif
  1090.    next
  1091.  
  1092.    muserid := userid
  1093.  
  1094.    for mrow = 1 to num_recs
  1095.       if muserid != userid
  1096.          muserid := userid
  1097.       endif
  1098.  
  1099.       mcol := 11
  1100.       zz   := -1
  1101.       @ mrow + 2, 2 ssay muserid
  1102.  
  1103.       if eof()
  1104.          exit
  1105.       endif
  1106.  
  1107.       for yy = 0 to 6
  1108.          if userid != muserid .or. eof()
  1109.             muserid := userid
  1110.             exit
  1111.          endif
  1112.          muserid := userid
  1113.  
  1114.          //───── if we are on a sunday, find the next weekday record and
  1115.          //───── leave an add'l space on screen to denote this break
  1116.          if dow(pdate + yy) = 1
  1117.             do while date == pdate + yy
  1118.                skip
  1119.             enddo
  1120.             mcol += 2
  1121.             loop
  1122.          endif
  1123.  
  1124.          //───── if we are on a saturday, find the next weekday record
  1125.          if dow(pdate + yy) = 7
  1126.             do while date = pdate + yy
  1127.                skip
  1128.             enddo
  1129.             loop
  1130.          endif
  1131.          zz++
  1132.          //───── again, alternate between two different background characters
  1133.          //───── (ascii 176 and 177) so that each employee's line is distinct
  1134.          afill(times_, 176 + (mrow % 2))
  1135.          if date = pdate + yy
  1136.             do while date = pdate + yy .and. ;
  1137.                      muserid = userid .and. ! eof()
  1138.                if val(left(time, 2)) > 5
  1139.                   mstart := val(left(time, 2)) - 5
  1140.                   //───── the min() function ensures that we won't blow up
  1141.                   //───── our array with a subscript greater than 12
  1142.                   mend := min(val(left(endtime, 2)) - 5, 12)
  1143.                   for xx = mstart to mend
  1144.                      times_[xx] := 219
  1145.                   next
  1146.                endif
  1147.                skip
  1148.             enddo
  1149.             dispbegin()
  1150.             setpos(mrow + 2, mcol + zz * 13)
  1151.             aeval(times_, { | hour | qqout(chr(hour)) })
  1152.             dispend()
  1153.          endif
  1154.       next
  1155.    next
  1156.    setcolor(oldcolor)
  1157.    use
  1158.    ginkey(0)
  1159.    byebyebox(buffer1)
  1160. else
  1161.    Err_Msg("No appointments for the week of " + dtoc(pdate) + " - " + ;
  1162.             dtoc(pdate + 4))
  1163. endif
  1164. ferase(mfile + '.dbf')
  1165. ferase(mfile + '.dbt')
  1166. ferase(mfile + '.ntx')
  1167. select(wk_area)
  1168. return NIL
  1169.  
  1170. * end static function Appt_Week()
  1171. *--------------------------------------------------------------------*
  1172.  
  1173.  
  1174. /*
  1175.    Function: ApptPrintW()
  1176.    Calls: PRINTOK()      (function in PRINTOK.PRG)
  1177.         : APPT_HEAD()
  1178. */
  1179. static function apptprintw()
  1180. local page, xx, buffer, muserid := padr("ALL", 8), mfile, n, d, num_recs, ;
  1181.       mstart := tdate - (dow(tdate) - 2), wk_area, mdbf, mcol, mdate,     ;
  1182.       maxrow, aday, arow, mbrief, puserid, adata[150], getlist := {}
  1183. field userid, date, time, endtime, brief
  1184. ColorSet(C_MESSAGE)
  1185. buffer := shadowbox(12, 27, 14, 52, 2)
  1186. @ 13, 29 ssay 'Employee ID:'
  1187. @ row(), col() + 1 get muserid picture "@!" valid ! empty(muserid)
  1188. setcursor(1)
  1189. read
  1190. setcursor(0)
  1191. ByeByeBox(buffer)
  1192. if lastkey() != K_ESC
  1193.    waiton()
  1194.    mdbf := randfile("appt")
  1195.    wk_area = select()
  1196.    mcol := 11
  1197.    if muserid = 'ALL'
  1198.       copy to (mdbf) for appt->date >= mstart .and. appt->date < mstart + 5
  1199.    else
  1200.       copy to (mdbf) for appt->date >= mstart .and. appt->date < mstart + 5 ;
  1201.                                .and. appt->userid == muserid
  1202.    endif
  1203.    use (mdbf) new exclusive
  1204.    pack
  1205.    if lastrec() = 0
  1206.       err_msg('No records found!')
  1207.    else
  1208.       index on userid to (mdbf) unique
  1209.       count to num_recs
  1210.       index on userid + dtos(date) + time to (mdbf)
  1211.       go top
  1212.       if printok()
  1213.          page := maxrow := 0
  1214.          Appt_HeadW(@page, mstart)
  1215.          arow := 7
  1216.          for xx = 1 to num_recs
  1217.             muserid := userid
  1218.             maxrow := 0
  1219.             afill (adata,space(13))
  1220.             do while muserid == userid .and. ! eof()
  1221.                mdate := date
  1222.                d     := 1
  1223.                aday  := dow(date) - 1
  1224.                adata[aday] = ' ' + time + '-' + endtime
  1225.                do while mdate = date .and. ;
  1226.                         muserid = userid .and. ! eof()
  1227.                   mbrief := brief
  1228.                   adata[++d * 5 - (5-aday)] = substr(mbrief, 1, 13)
  1229.                   skip
  1230.                   if mdate = date .and. muserid == userid
  1231.                      adata[++d * 5 - (5-aday)] := replicate('─',13)
  1232.                      adata[++d * 5 - (5-aday)] := ' ' + time + '-' + endtime
  1233.                   endif
  1234.                enddo
  1235.                maxrow := max(maxrow, d)
  1236.             enddo
  1237.             @ arow,0 say '║' + muserid + '║'
  1238.             for n = 1 to 5
  1239.                @ arow, (n * 14) - 4 say adata[n]
  1240.                if n < 5
  1241.                   @ arow, (n * 14) + 9 say '│'
  1242.                endif
  1243.             next
  1244.             puserid := '║' + space(8) + '║'
  1245.             for n = 6 to (maxrow * 5)
  1246.                d = n % 5
  1247.                if d = 0
  1248.                   d = 5
  1249.                endif
  1250.                if d = 1
  1251.                   @ arow, 79 say '║'
  1252.                   arow++
  1253.                   if arow > 56
  1254.                      Appt_HeadW(@page, mstart)
  1255.                      arow := 7
  1256.                      puserid := '║  ' + muserid + '   ║'
  1257.                   endif
  1258.                   @ arow,0 say puserid
  1259.                   puserid := '║' + space(8) + '║'
  1260.                else
  1261.                   @ arow,(d*14)-5 say '│'
  1262.                endif
  1263.                @ arow,(d*14)-4 say left(adata[n], 13)
  1264.             next
  1265.             @ arow, 79 say '║'
  1266.             arow++
  1267.             if xx < num_recs .and. ! eof()
  1268.                if arow > 52
  1269.                   Appt_HeadW(@page, mstart)
  1270.                   arow := 7
  1271.                else
  1272.                   @ arow++,0 say '╠════════╬' + replicate('═════════════╪',4) ;
  1273.                                  + '═════════════╣'
  1274.                endif
  1275.             endif
  1276.          next
  1277.          @ arow,0 say '╚════════╩' + replicate('═════════════╧',4) + ;
  1278.                       '═════════════╝'
  1279.          eject
  1280.       endif
  1281.       set device to screen
  1282.    endif
  1283.    waitoff()
  1284.    use
  1285.    select(wk_area)
  1286.    ferase(mdbf + '.dbf')
  1287.    ferase(mdbf + '.dbt')
  1288.    ferase(mdbf + '.ntx')
  1289. endif
  1290. return NIL
  1291.  
  1292. * end static function Appt_PrintW()
  1293. *--------------------------------------------------------------------*
  1294.  
  1295.  
  1296. /*
  1297.    Function: Appt_HeadW()
  1298.    Heading for appointment report (weekly)
  1299. */
  1300. static function appt_headw(page, mstart)
  1301. local xx
  1302. if page > 0
  1303.    @ row(),0 say '╚════════╩' + replicate('═════════════╧',4) + '═════════════╝'
  1304.    eject
  1305. endif
  1306. @ 1, 1 say dtoc(date())
  1307. CENTER(1, 'Appointments for ' + dtoc(mstart) + ' through ' + dtoc(mstart + 4))
  1308. @ 1,73 say 'page ' + ltrim(str(++page))
  1309. @ 4, 0 say '╔════════╦' + replicate('═════════════╤',4) + '═════════════╗'
  1310. @ 5, 0 say '║ Emp ID ║'
  1311. for xx = 1 to 5
  1312.    @ 5, xx * 14 - 3 say left(gfday(mstart + xx - 1), 3) + '-'
  1313.    @ 5, xx * 14 + 2 say str(day(mstart + xx - 1), 2) + ' ' + ;
  1314.                        left(gfmonth(mstart + xx - 1), 3)
  1315.    if xx < 5
  1316.       @ 5, xx * 14 + 9 say '│'
  1317.    endif
  1318. next
  1319. @ 5, 79 say '║'
  1320. @ 6,  0 say '╠════════╬' + replicate('═════════════╪',4) + '═════════════╣'
  1321. return NIL
  1322.  
  1323. * end static function Appt_HeadW()
  1324. *--------------------------------------------------------------------*
  1325.  
  1326.  
  1327. //───── function under construction
  1328. /*
  1329.  
  1330.    Function: Appt_Meet()
  1331.    Schedule a meeting
  1332. static function appt_meet
  1333. local buffer1, buffer2, oldcolor := setcolor("+gr/n"), muserid, getlist:={}, ;
  1334.       mtime := "00:00", mendtime := "00:00", mdescrip := space(50), 
  1335. buffer1 = shadowbox(12, 06, 15, 73, 2, 'Schedule Meeting')
  1336. @ 13, 8 ssay 'Start time:'
  1337. @ 13,30 ssay 'Ending time:'
  1338. @ 14, 8 ssay 'Description:'
  1339. @ 13,21 get mtime picture "##:##"
  1340. @ 13,43 get mendtime picture "##:##" valid mendtime >= mtime .or. ;
  1341.                                            lastkey() = K_UP
  1342. @ 14,21 get mdescrip
  1343. setcursor(1)
  1344. read
  1345. setcursor(0)
  1346. if ! empty(mtime)
  1347.    buffer2 = shadowbox(17, 27, 19, 52, 2)
  1348.    do while lastkey() != K_ESC
  1349.       muserid = space(8)
  1350.       @ 18, 29 ssay 'Employee ID:' get muserid picture "@!" ;
  1351.                                    valid ! empty(muserid)
  1352.       setcursor(1)
  1353.       read
  1354.       setcursor(0)
  1355.       if lastkey() != K_ESC
  1356.          if noconflict("A", tdate, muserid)
  1357.             append blank
  1358.             app_ok = ! neterr()
  1359.             if app_ok
  1360.                replace date with tdate, time with mtime, endtime with mendtime, ;
  1361.                        brief with mdescrip, userid with muserid
  1362.                unlock
  1363.             else
  1364.                err_msg(NETERR_MSG)
  1365.             endif
  1366.          endif
  1367.       endif
  1368.    enddo
  1369.    byebyebox(buffer2)
  1370. endif
  1371. byebyebox(buffer1)
  1372. setcolor(oldcolor)
  1373. return NIL
  1374.  
  1375. */
  1376.  
  1377.  
  1378. /*
  1379.     Function: Appt_Dom()
  1380.     Determine which day of month, e.g., 2nd Monday, 3rd Tuesday, etc
  1381. */
  1382. static function Appt_Dom(mdate)
  1383. local mday := cdow(mdate), ret_val := 0, mmonth := month(mdate)
  1384. do while month(mdate) == mmonth
  1385.    mdate -= 7
  1386.    ret_val++
  1387. enddo
  1388. return ret_val
  1389.  
  1390. * end static function Appt_Dom()
  1391. *--------------------------------------------------------------------*
  1392.  
  1393. * eof popdate.prg
  1394.