home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR8 / 123EXP.ZIP / IMPRTWK1.CLA < prev    next >
Text File  |  1994-01-07  |  31KB  |  724 lines
  1.             MEMBER('cs')
  2. imp123to    PROCEDURE
  3. !******************************************************************************
  4. !   This sample program illustrates the method for importing from a 1-2-3
  5. !   format spreadsheet file.
  6.  
  7. !   The key routines to reference are:
  8. !       check_ver       - Verifies that the input file is a spreadsheet
  9. !       find_A10        - Scans through the spreadsheet looking for a
  10. !                           particular data cell (in this case, cell A:10)
  11. !       get_next        - Reads the next spreadsheet file "record"
  12. !       read_text       - Reads a "label" cell
  13. !       read_number     - Reads a numeric cell
  14.  
  15. !   DISCLAIMER: I have not spent any time cleaning up this code.  There are
  16. !   lots of calls to other functions and procedures that I have not removed.
  17. !   There are also references to global variables and files that I have not
  18. !   provided.
  19. !******************************************************************************
  20.  
  21. !══════════════════════════════════════════════════════════════════════════════
  22. !   RED - 03/12/92
  23. !
  24. !   This procedure is used to import takeoffs from a 1-2-3 format spreadsheet
  25. !   file.  The takeoffs must start at Row 10, Column A and the columns must
  26. !   be in the following order.  The first blank row after A10 will be
  27. !   considered the end of the list of takeoffs.
  28. !
  29. !       Column  Field               Type
  30. !       ------  ------------------  ------
  31. !          A    Category            Label
  32. !          B    Contract            Label
  33. !          C    Component           Label
  34. !          D    Property Unit #     Label
  35. !          E    Takeoff #           Number
  36. !          F    TO Description      Label
  37. !          G    Quantity            Number
  38. !          H    UOM                 Label
  39. !          I    Unit Price          Number
  40. !          J    Cost Source Code    Number
  41. !          K    Flags               Label - in this order: " Y Y Y N N N N"
  42. !                                                           12345678901234
  43. !          L    Reference number    Label
  44. !          M    Blueprint           Label
  45. !          N    Source              Label
  46. !
  47. !   Revision History
  48. !   ────────────────
  49. !   12/08/92 - Added check to ensure that the indirect flags are coded
  50. !              correctly.
  51. !══════════════════════════════════════════════════════════════════════════════
  52. file_scr    SCREEN         WINDOW(13,58),PRE(scr),HLP('imp123to'),HUE(7,1,0)
  53.                 ROW(2,3)   PAINT(10,48),HUE(11,1)
  54.                 ROW(13,1)  PAINT(1,1),TRN
  55.                 ROW(1,58)  PAINT(1,1),TRN
  56.                 ROW(2,58)  PAINT(11,1),HUE(8,0),TRN
  57.                 ROW(13,2)  PAINT(1,57),HUE(8,0),TRN
  58.                 ROW(5,3)   PAINT(4,53),HUE(11,1)
  59.                 ROW(6,9)   PAINT(2,46),HUE(15,1)
  60.                 ROW(2,51)  PAINT(3,2),HUE(11,1)
  61.                 ROW(1,1)   STRING('╒═<0{40}>═{14}╕')
  62.                 ROW(2,1)   REPEAT(10);STRING('│<0{55}>│') .
  63.                 ROW(12,1)  STRING('╘═{55}╛')
  64.                 ROW(2,3)   STRING('┌─<0{21}>─{26}┐')
  65.                 ROW(3,3)   STRING('│<0{48}>│')
  66.                 ROW(4,3)   STRING('└─{48}┘')
  67.                 ROW(5,3)   STRING('┌─<0{7}>─{43}┐')
  68.                 ROW(6,3)   REPEAT(2);STRING('│<0{51}>│') .
  69.                 ROW(8,3)   STRING('└─{51}┘')
  70.                 ROW(9,3)   STRING('┌─<0{9}>─┐')
  71.                 ROW(10,3)  STRING('│<0{11}>│')
  72.                 ROW(11,3)  STRING('└─{11}┘')
  73.                 ROW(1,3)   STRING('Import Takeoffs from a 1-2-3 Spreadsheet')
  74.                 ROW(2,5)   STRING('Spreadsheet File Name')
  75.                 ROW(5,5)   STRING('Options')
  76.                 ROW(6,7)   STRING(']')
  77.                     COL(8) STRING(' '),HUE(15,1)
  78.                     COL(9) STRING('Delete ALL existing takeoffs before importing')
  79.                 ROW(7,4)   STRING(' '),HUE(15,1)
  80.                     COL(7) STRING(']')
  81.                     COL(9) STRING('Write over any existing duplicate takeoffs')
  82.                 ROW(9,5)   STRING('Continue?')
  83.                 ROW(3,5)   ENTRY(@S46),USE(wks_filename),HUE(15,1),SEL(15,4),LFT,UPR
  84.                 ROW(6,5)   STRING('[')
  85.                     COL(6) ENTRY(@S1),USE(del_all_a),HUE(14,1),SEL(15,4),OVR,IMM,LFT,UPR
  86.                 ROW(7,5)   STRING('[')
  87.                     COL(6) ENTRY(@S1),USE(writeover_a),HUE(14,1),SEL(15,4),OVR,IMM,LFT,UPR
  88.                 ROW(10,12) MENU(@S3),USE(mem:continue),HUE(1,1),SEL(1,1),REQ,IMM
  89.                     COL(5)     STRING('No'),HUE(15,1),SEL(15,4)
  90.                     COL(8)     STRING('Yes'),HUE(15,1),SEL(15,4)
  91.             .              .
  92.  
  93. stat_screen SCREEN         WINDOW(13,43),AT(11,37),PRE(sta),HUE(9,7,0)
  94.                 ROW(2,43)  PAINT(11,1),HUE(8,0),TRN
  95.                 ROW(13,2)  PAINT(1,42),HUE(8,0),TRN
  96.                 ROW(13,1)  PAINT(1,1),TRN
  97.                 ROW(1,43)  PAINT(1,1),TRN
  98.                 ROW(3,3)   PAINT(7,38),HUE(1,7)
  99.                 ROW(11,3)  PAINT(1,27),HUE(8,7)
  100.                 ROW(1,1)   STRING('█▀{40}█'),ENH
  101.                 ROW(2,1)   REPEAT(5);STRING('█<0{40}>█'),ENH .
  102.                 ROW(10,2)  STRING('─{40}'),ENH
  103.                 ROW(11,1)  STRING('█<0{40}>█'),ENH
  104.                 ROW(12,1)  STRING('█▄{40}█'),ENH
  105.                 ROW(3,3)   STRING('┌─<0{8}>─{5}┐<0>┌─<0{17}>─┐')
  106.                 ROW(4,3)   REPEAT(2);STRING('│<0{14}>│<0>│<0{19}>│') .
  107.                 ROW(6,3)   STRING('└─{14}┘<0>│<0{19}>│')
  108.                 ROW(7,3)   STRING('┌─<0{4}>────┐<0{6}>╞═{19}╡')
  109.                 ROW(8,3)   STRING('│<0{9}>│<0{6}>│<0{19}>│')
  110.                 ROW(9,3)   STRING('└─{9}┘<0{6}>└─{19}┘')
  111.                 ROW(7,1)   REPEAT(4);STRING('█<0{40}>█') .
  112.                 ROW(3,5)   STRING('Position')
  113.                     COL(22) STRING('Takeoffs imported')
  114.                 ROW(4,24)  STRING('Added:')
  115.                 ROW(5,22)  STRING('Updated:')
  116.                 ROW(6,22)  STRING('Skipped:')
  117.                 ROW(7,5)   STRING('Cell')
  118.                 ROW(8,6)   STRING(':')
  119.                     COL(24) STRING('Total:')
  120.                 ROW(11,3)  STRING('Press [Shift+Esc] to abort.')
  121. message         ROW(2,3)   STRING(38),HUE(0,7)
  122. wks_pointer     ROW(4,8)   STRING(@N9),HUE(0,7)
  123. file_size       ROW(5,5)   STRING(12),HUE(0,7)
  124. col             ROW(8,5)   STRING(1),HUE(0,7)
  125. row                 COL(7) STRING(5),HUE(0,7)
  126. add_cnt         ROW(4,31)  STRING(@N9),HUE(0,7)
  127. update_cnt      ROW(5,31)  STRING(@N9),HUE(0,7)
  128. skipped_cnt     ROW(6,31)  STRING(@N9),HUE(0,7)
  129. rec_cnt         ROW(8,31)  STRING(@N9),HUE(0,7)
  130.             .
  131.  
  132.     INCLUDE('wks_file.inc')
  133.  
  134. flags           STRING(15)
  135. rec_cnt         LONG
  136. add_cnt         LONG
  137. update_cnt      LONG
  138. skipped_cnt     LONG
  139. final_cnt       LONG
  140. err_prefix      STRING(60)
  141.  
  142. hold_takeoff    GROUP;BYTE,DIM(SIZE(tko:record)).
  143.  
  144. del_all_bx      GROUP
  145. del_all             BYTE
  146. del_all_a           STRING(1)
  147.                 .
  148. writeover_bx    GROUP
  149. writeover           BYTE
  150. writeover_a         STRING(1)
  151.                 .
  152. !──────────────────────────────────────────────────────────────────────────────
  153.     CODE
  154.  
  155.     DO lock_takeoff                         ! Lock the takeoff file, if possible
  156.     DO get_filename                         ! Get the name of the WKS file
  157.  
  158.     STREAM(takeoff)
  159.  
  160.     IF del_all                              ! Clear out the takeoffs if
  161.         EMPTY(takeoff)                      !   requested.
  162.     .
  163.     sta:message = 'Importing the takeoffs...'
  164.     cur_row = wks:row                       ! Set the current row
  165.     cur_col = 0                             !   and column
  166.     LOOP UNTIL wks_pointer > file_size      ! Go thru each row in the spreadsheet
  167.         CLEAR(tko:record)                   ! Initialize the takeoff record
  168.  
  169.         sta:row = cur_row + 1               ! Display the row number
  170.         LOOP UNTIL wks_pointer > file_size  ! Read each field on the row
  171.             org_pointer = wks_pointer       ! Save the current file position
  172.  
  173.             sta:col = CHR(cur_col + 65)     ! Display the column letter
  174.  
  175.             EXECUTE cur_col +1              ! Get the correct field depending
  176.                 DO get_cat                  !   on the column we're on.
  177.                 DO get_cont
  178.                 DO get_comp
  179.                 DO get_ppu
  180.                 DO get_tko_no
  181.               ! DO skip_column              ! There's a blank column between the TO# and the desc - if there's anything there, skip over it.
  182.                 DO get_desc
  183.                 DO get_quantity
  184.                 DO get_uom
  185.                 DO get_price
  186.                 DO get_src_code
  187.                 DO get_flags
  188.                 DO get_ref
  189.                 DO get_blue
  190.                 DO get_source
  191.             .
  192.             DO abort_check
  193.  
  194.             IF org_pointer = wks_pointer    ! Did we get any data?
  195.                 IF cur_col > 13             ! No.  Are we on the last field?
  196.                     DO write_tko            ! Yes. Write the takeoff record
  197.                     DO down_1_row           !   and move to the next row
  198.                     BREAK
  199.             .   .
  200.             cur_col += 1                    ! Move to the next column
  201.     .   .
  202.     FLUSH(takeoff)
  203.     sta:wks_pointer = file_size                 ! Make sure the displayed sizes match
  204.     sta:message     = ''                        ! Clear the message
  205.  
  206.     OPEN(msg_box); msg_text = 'Resetting the spreadsheet.  Just a moment...'
  207.     DO cleanup
  208.  
  209.     final_cnt = add_cnt + update_cnt
  210.     CASE final_cnt
  211.     OF 0
  212.         done_msg('No takeoffs were imported.')
  213.     OF 1
  214.         done_msg('One takeoff was imported.')
  215.     ELSE
  216.         done_msg(CLIP(RIGHT(FORMAT(final_cnt,@n9),9)) & ' takeoffs were imported.')
  217.     .
  218.     RETURN
  219.  
  220. !───Routines───────────────────────────────────────────────────────────────────
  221. lock_takeoff    ROUTINE
  222.     CLOSE(takeoff)
  223.     OPEN (takeoff)      ! Open the file in exclusive use mode to lockout anyone
  224.     IF ERRORCODE()      !   from using it while it's importing.
  225.         err_msg('Importing cannot be done while someone else is using the project.')
  226.         SHARE(takeoff)
  227.         IF ERRORCODE()
  228.             err_msg('Cannot re-open the takeoff file.')
  229.         .
  230.         RETURN
  231.     ELSE
  232.         cat:id       = ''       ! Initialize the lookup key fields
  233.         ppu:no       = ''
  234.         cmp:id       = ''
  235.         cmp:ppu_no   = ''
  236.         dsc:id       = ''
  237.         dsc:rec_type = mem:src_desc_cd
  238.     .
  239.  
  240. get_filename    ROUTINE     ! Accept the name of the spreadsheet to import
  241.                             !   and be sure it's a valid takeoff spreadsheet
  242.     del_all      = false                            ! Set defaults
  243.     del_all_a    = ''
  244.     writeover    = true
  245.     writeover_a  = '√'
  246.     mem:continue = 'No'
  247.  
  248.     OPEN(file_scr)                                      ! Display the window
  249.     IF prj:imp123to_fil = ''
  250.         wks_filename = CLIP(cfg:data_dir) & '\TAKEOFFS.WK1' ! Default filename
  251.     ELSE
  252.         wks_filename = prj:imp123to_fil
  253.     .
  254.     SETCURSOR                                           ! Cursor off
  255.     DISPLAY                                             ! Display fields
  256.  
  257.     LOOP
  258.         ALERT                                           ! Reset all keys
  259.         ALERT(esc_key)                                  ! Enable the Esc key
  260.         ALERT(reject_key)                               !   and the Ctrl+Esc key
  261.         ALIAS(ctrl_esc,reject_key)
  262.         ALERT(accept_key)
  263.         ALERT(F3_key)
  264.         ACCEPT                                          ! Accept the filename
  265.  
  266.         CASE KEYCODE()
  267.         OF reject_key
  268.             DO cleanup
  269.             RETURN
  270.         OF esc_key
  271.             IF FIELD() = ?wks_filename
  272.                 DO cleanup
  273.                 RETURN
  274.             ELSE
  275.                 SELECT(?-1); CYCLE
  276.             .
  277.         OF F3_key
  278.             IF FIELD() <> ?wks_filename
  279.                 BEEP
  280.                 SELECT(?); CYCLE
  281.         .   .
  282.  
  283.         CASE FIELD()
  284.         OF ?wks_filename
  285.             IF KEYCODE() = esc_key
  286.                 DO cleanup
  287.                 RETURN
  288.             .
  289.             IF (wks_filename = '')              OR |
  290.                (KEYCODE() = F3_key)             OR |
  291.                (INSTRING('*',wks_filename,1,1)) OR |
  292.                (INSTRING('?',wks_filename,1,1))
  293.                 UPDATE
  294.                 IF wks_filename = ''
  295.                     wks_filename = '*.WK1'          ! Select spreadsheets
  296.                 .
  297.                 IF sel_file(wks_filename,,files_only)
  298.                     DISPLAY(?wks_filename)          ! Redisplay selected file
  299.                 ELSE
  300.                     SELECT(?); CYCLE
  301.             .   .
  302.             IF NOT namevalid(wks_filename)
  303.                 disp_msg('Invalid filename syntax. Please re-enter.')
  304.                 SELECT(?); CYCLE
  305.             .
  306.             ! Add a default ".WK1" extension if there isn't one
  307.             IF NOT INSTRING('.',wks_filename,1)
  308.                 wks_filename = CLIP(wks_filename) & '.WK1'
  309.                 DISPLAY(?)
  310.             ELSE
  311.                 IF SUB(wks_filename,-1,1) = '.'     ! Period at last position?
  312.                     wks_filename = CLIP(wks_filename) & 'WK1'
  313.                     DISPLAY(?)
  314.             .   .
  315.             IF NOT filexists(wks_filename)
  316.                 disp_msg('Filename not found. Please re-enter.')
  317.                 SELECT(?); CYCLE
  318.             .
  319.         OF ?del_all_a;   checkbox(del_all_bx)
  320.         OF ?writeover_a; checkbox(writeover_bx)
  321.  
  322.         OF ?mem:continue
  323.             IF mem:continue <> 'Yes'
  324.                 DO cleanup
  325.                 RETURN
  326.             .
  327.             DO check_ver
  328.             IF wks_pointer > 0                  ! Good WKS file?
  329.                 DO init_stats                   ! Display the stat screen
  330.                 DO find_a10                     ! Find the takeoff list
  331.                 IF wks_pointer NOT > file_size  ! Any takeoffs found?
  332.                     BREAK                       ! Yes - continue
  333.             .   .
  334.             SELECT(?wks_filename); CYCLE
  335.     .   .
  336.  
  337. check_ver   ROUTINE         ! Check for a valid spreadsheet file. wks_pointer
  338.                             !   is > 0 if it's valid.
  339.     OPEN(wks_file)
  340.     IF ERRORCODE()
  341.         err_msg('Unable to access the spreadsheet file.')
  342.         wks_pointer = 0
  343.     ELSE
  344.         file_size = BYTES(wks_file)         ! Save the size of the file
  345.  
  346.         GET(wks_file,1,6)                   ! Read the BOF record
  347.         IF (wks:opcode  = bof_op) AND |     ! BOF record?
  348.           ((wks:version = ver_123_1) OR |   ! Version 1.x or
  349.            (wks:version = ver_123_2))       !   2.x spreadsheet?
  350.             wks_pointer = 7                 ! Yes - continue on
  351.         ELSE
  352.             wks_pointer = 0                 ! No - try again
  353.             CLOSE(wks_file)
  354.             disp_msg('Not a valid 1-2-3 spreadsheet file. Please re-enter.')
  355.     .   .
  356.  
  357. init_stats   ROUTINE
  358.     rec_cnt        = 0          ! Init the counters
  359.     add_cnt        = 0
  360.     update_cnt     = 0
  361.     skipped_cnt    = 0
  362.  
  363.     OPEN(stat_screen)
  364.     sta:file_size   = RIGHT('of ' & LEFT(FORMAT(file_size,@N9),9),12)
  365.     sta:row         = 1
  366.     sta:col         = 'A'
  367.     sta:rec_cnt     = rec_cnt
  368.     sta:add_cnt     = add_cnt
  369.     sta:update_cnt  = update_cnt
  370.     sta:skipped_cnt = skipped_cnt
  371.  
  372.     prj:imp123to_fil = wks_filename     ! Save the filename in
  373.     PUT(project)                        !   the project record
  374.  
  375. find_a10    ROUTINE     ! Find the cell data for Column A, Row 10. Must be a 3
  376.                         !   character string, data will be a total of 10 bytes
  377.                         !   long.
  378.     sta:message = 'Looking for the first spreadsheet cell...'
  379.  
  380.     GET(wks_file,wks_pointer,4)             ! Read the first record header
  381.     LOOP UNTIL wks_pointer > file_size      ! Find the start of the list of data records
  382.         IF INRANGE(wks:opcode,integer_op,formula_op)    ! Data opcode?
  383.             BREAK                           ! wks_pointer points to the start of the 1st data record
  384.         .
  385.         DO get_next
  386.         LOOP UNTIL NOT KEYBOARD()           ! Check for the abort key
  387.             ASK                             !   sequence and re-accept the
  388.             IF (KEYCODE() = reject_key) OR |    !   filename if it was pressed.
  389.                (KEYCODE() = ctrl_esc)
  390.                 DO scan_abort
  391.                 EXIT
  392.     .   .   .
  393.     IF wks_pointer > file_size              ! Any data found?
  394.         DO format_err                       !   No.
  395.         EXIT
  396.     .
  397.     sta:message = 'Looking for the list of takeoffs...'
  398.  
  399.     GET(wks_file,wks_pointer,9)             ! Read the data record header
  400.     LOOP UNTIL wks_pointer > file_size
  401.         IF (wks:opcode = label_op)  AND |   ! Label opcode?
  402.            (wks:length > 9)         AND |   ! Is the data 10 bytes or larger? (the category should be 3 chars long)
  403.            (wks:col = 0) AND (wks:row = 9)  ! Column A, Row 10?
  404.             BREAK                           ! Found it - start reading here (at wks_pointer position)
  405.         .
  406.         IF wks:row > 10                     ! Are we past where the takeoffs
  407.             wks_pointer = file_size + 1     !   should start?
  408.             sta:row = wks:row + 1           ! Update the row
  409.             sta:col = CHR(wks:col + 65)     !   and column on the display
  410.             BREAK                           !   and exit
  411.         .
  412.         DO get_next
  413.         LOOP UNTIL NOT KEYBOARD()           ! Check for the abort key
  414.             ASK                             !   sequence
  415.             IF (KEYCODE() = reject_key) OR |
  416.                (KEYCODE() = ctrl_esc)
  417.                 DO scan_abort; EXIT
  418.     .   .   .
  419.     IF wks_pointer > file_size  ! Any takeoffs found?
  420.         DO format_err           !   No.
  421.     .
  422.  
  423. get_next    ROUTINE             ! Get the next 123 record
  424.     wks_pointer += wks:length + 4       ! Move over the current record
  425.     GET(wks_file,wks_pointer,9)         !   and read the next header
  426.     sta:wks_pointer = wks_pointer       ! Display the counter
  427.  
  428. format_err  ROUTINE             ! Display spreadsheet format error
  429.     sta:message = ''
  430.     CLOSE(wks_file)
  431.     disp_msg('Invalid spreadsheet format.  Takeoffs must start at Column A, Row 10.')
  432.     CLOSE(stat_screen)
  433.  
  434. scan_abort  ROUTINE             ! Abort the initial scan
  435.     BEEP
  436.     OPEN(msg_box); msg_text = 'Aborting.  Just a moment...'
  437.     DO cleanup
  438.     disp_msg('The scanning was aborted as requested.')
  439.     CLOSE(stat_screen)
  440.     wks_pointer = file_size + 1 ! Accept the filename again
  441.  
  442. get_cat     ROUTINE
  443.     DO read_text
  444.     tko:category = UPPER(SUB(wks:string,1, wks:length - 7))
  445.     IF tko:category = ''        ! Stop at the first blank row
  446.         wks_pointer = file_size + 1
  447.     ELSE
  448.         IF cat:id <> tko:category
  449.             cat:id = tko:category
  450.             GET(category,cat:key)
  451.             IF ERRORCODE()
  452.                 err_prefix = '"' & CLIP(tko:category) & '" is an invalid category'
  453.                 DO lookup_err
  454.     .   .   .
  455.  
  456. get_cont    ROUTINE
  457.     DO read_text
  458.     tko:contract = UPPER(SUB(wks:string,1, wks:length - 7))
  459.     IF tko:contract = ''
  460.         err_prefix = 'A blank contract id is not valid'
  461.         DO lookup_err
  462.     ELSE
  463.         IF con:id <> tko:contract
  464.             con:id = tko:contract
  465.             GET(contract,con:id_key)
  466.             IF ERRORCODE()
  467.                 err_prefix = '"' & CLIP(tko:contract) & '" is an invalid contract'
  468.                 DO lookup_err
  469.     .   .   .
  470.  
  471. get_comp    ROUTINE
  472.     DO read_text
  473.     tko:component = UPPER(SUB(wks:string,1, wks:length - 7))
  474.     IF tko:component = ''           ! Can only check the component after we have the PPU# below
  475.         err_prefix = 'A blank component id is not valid'
  476.         DO lookup_err
  477.     .
  478.  
  479. get_ppu     ROUTINE
  480.     DO read_text
  481.     tko:ppu_no = UPPER(SUB(wks:string,1, wks:length - 7))
  482.     IF tko:ppu_no = ''
  483.         err_prefix = 'A blank property unit number is not valid'
  484.         DO lookup_err
  485.     ELSE
  486.         IF ppu:no <> tko:ppu_no
  487.             ppu:no = tko:ppu_no
  488.             GET(propunit,ppu:key)
  489.             IF ERRORCODE()
  490.                 err_prefix = '"' & CLIP(tko:ppu_no) & '" is an invalid property unit'
  491.                 DO lookup_err
  492.         .   .
  493.         IF (cmp:id     <> tko:component) OR |
  494.            (cmp:ppu_no <> tko:ppu_no)
  495.             cmp:id     = tko:component
  496.             cmp:ppu_no = tko:ppu_no
  497.             GET(cmponent,cmp:key)
  498.             IF ERRORCODE()
  499.                 err_prefix = '"' & CLIP(tko:component) & '-' & CLIP(tko:ppu_no) & '" is an invalid component'
  500.                 DO lookup_err
  501.     .   .   .
  502.  
  503. get_tko_no  ROUTINE
  504.     DO read_number
  505.     tko:takeoff_no = wks_number
  506.  
  507. get_desc    ROUTINE
  508.     DO read_text
  509.     tko:desc = SUB(wks:string,1, wks:length - 7)
  510.  
  511. get_quantity ROUTINE
  512.     DO read_number
  513.     tko:quantity = wks_number
  514.  
  515. get_uom     ROUTINE
  516.     DO read_text
  517.     tko:uom = UPPER(SUB(wks:string,1, wks:length - 7))
  518.  
  519. get_price   ROUTINE
  520.     DO read_number
  521.     tko:unit_price = wks_number
  522.  
  523. get_src_code ROUTINE
  524.     DO read_number
  525.     tko:cost_src_cd = wks_number
  526.     IF tko:cost_src_cd = 0
  527.         err_prefix = 'A blank cost source code is not valid'
  528.         DO lookup_err
  529.     ELSE
  530.         IF dsc:code <> tko:cost_src_cd
  531.             dsc:id   = ''
  532.             dsc:code = tko:cost_src_cd
  533.             GET(desc,dsc:key)
  534.             IF ERRORCODE()              ! Display "wks_number" in case the number is larger than a SHORT
  535.                 err_prefix = '"' & CLIP(wks_number) & '" is an invalid cost source code'
  536.                 DO lookup_err
  537.     .   .   .
  538.  
  539. get_flags    ROUTINE
  540.     DO read_text
  541.     flags = UPPER(SUB(wks:string,1, wks:length - 7))
  542.  
  543.     ! The flags are in the spreadsheet in this order: " Y Y Y N N N N"
  544.     !                                                  12345678901234
  545.     tko:prj_ind_flg  = SUB(flags, 2,1)
  546.     tko:cat_ind_flg  = SUB(flags, 4,1)
  547.     tko:con_ind_flg  = SUB(flags, 6,1)
  548.     tko:time_loc_flg = SUB(flags, 8,1)
  549.     tko:job_cond_flg = SUB(flags,10,1)
  550.     tko:variance_flg = SUB(flags,12,1)
  551.     tko:ins_fctr_flg = SUB(flags,14,1)
  552.  
  553.     ! Check that the flag were coded correctly
  554.     IF NOT ( ((tko:prj_ind_flg  = 'Y') OR (tko:prj_ind_flg  = 'N')) AND |
  555.              ((tko:cat_ind_flg  = 'Y') OR (tko:cat_ind_flg  = 'N')) AND |
  556.              ((tko:con_ind_flg  = 'Y') OR (tko:con_ind_flg  = 'N')) AND |
  557.              ((tko:time_loc_flg = 'Y') OR (tko:time_loc_flg = 'N')) AND |
  558.              ((tko:job_cond_flg = 'Y') OR (tko:job_cond_flg = 'N')) AND |
  559.              ((tko:variance_flg = 'Y') OR (tko:variance_flg = 'N')) AND |
  560.              ((tko:ins_fctr_flg = 'Y') OR (tko:ins_fctr_flg = 'N')) )
  561.         err_prefix = 'The indirect flags must be coded like: " Y Y Y N N N N"'
  562.         DO lookup_err
  563.     .
  564.  
  565. get_ref     ROUTINE
  566.     DO read_text
  567.     tko:reference_no = SUB(wks:string,1, wks:length - 7)
  568.  
  569. get_blue    ROUTINE
  570.     DO read_text
  571.     tko:blueprint_no = SUB(wks:string,1, wks:length - 7)
  572.  
  573. get_source  ROUTINE
  574.     DO read_text
  575.     tko:takeoff_src = SUB(wks:string,1, wks:length - 7)
  576.  
  577. skip_column ROUTINE     ! If there's any data in the current column,
  578.                         !   skip over it.  Otherwise, leave the pointer
  579.                         !   where it is.
  580.     GET(wks_file,wks_pointer,9)         ! Get the label header
  581.     IF wks:col = cur_col                ! Is there data in the column that should be skipped?
  582.         wks_pointer += (4 + wks:length) ! Yes - move the pointer to the next record
  583.         sta:wks_pointer = wks_pointer
  584.     .
  585.  
  586. lookup_err  ROUTINE     ! Display error info and exit
  587.     FLUSH(takeoff)
  588.  
  589.     disp_msg(CLIP(err_prefix) & ' (cell ' & sta:col & ':' & CLIP(sta:row) & ').')
  590.     OPEN(msg_box); msg_text = 'Terminating.  Just a moment...'
  591.     DO cleanup
  592.     disp_msg('The importing was terminated.  Please correct the error and try again.')
  593.     RETURN
  594.  
  595. write_tko   ROUTINE
  596.     IF (tko:contract   <> '') AND | ! Was a complete record built?
  597.        (tko:takeoff_no <>  0)
  598.         ADD(takeoff)                ! Yes - save it!
  599.         IF ERRORCODE()
  600.             IF ERRORCODE() = dupkey_err     ! Already exists?
  601.                 IF writeover = false
  602.                     skipped_cnt += 1; sta:skipped_cnt = skipped_cnt
  603.                 ELSE
  604.                     hold_takeoff = tko:record
  605.                     GET(takeoff,tko:key)        ! Get the existing takeoff
  606.                     IF NOT ERRORCODE()
  607.                         tko:record =  hold_takeoff
  608.                         PUT(takeoff)            ! Overwrite it
  609.                     .
  610.                     IF ERRORCODE()
  611.                         err_msg('Unable to update a takeoff (contract: ' & |
  612.                                     CLIP(tko:contract) & ', takeoff# ' & tko:takeoff_no & ').')
  613.                         OPEN(msg_box); msg_text = 'Aborting.  Just a moment...'
  614.                         DO cleanup
  615.                         RETURN
  616.                     ELSE
  617.                         update_cnt += 1; sta:update_cnt = update_cnt
  618.                 .   .
  619.             ELSE
  620.                 err_msg('Unable to add a takeoff (contract: ' & |
  621.                             CLIP(tko:contract) & ', takeoff# ' & tko:takeoff_no & ').')
  622.                 OPEN(msg_box); msg_text = 'Aborting.  Just a moment...'
  623.                 DO cleanup
  624.                 RETURN
  625.             .
  626.         ELSE
  627.             add_cnt += 1; sta:add_cnt = add_cnt
  628.         .
  629.         rec_cnt += 1; sta:rec_cnt = rec_cnt
  630.     .
  631.  
  632. down_1_row  ROUTINE     ! Skip any records between the current position
  633.                         !   and the column A of the next row.
  634.     cur_row += 1                            ! Set the expected new row
  635.     cur_col  = 0
  636.     LOOP UNTIL wks_pointer > file_size
  637.         GET(wks_file,wks_pointer,9)             ! Get the header
  638.         IF wks:opcode = eof_op                  ! 1-2-3 EOF mark?
  639.             wks_pointer = file_size + 1         ! All done
  640.             BREAK
  641.         ELSE
  642.             IF (wks:row = cur_row) AND |        ! Are we on column A of the
  643.                (wks:col = 0)                    !   next row?
  644.                 BREAK                           ! Yes - don't move the pointer
  645.             ELSE
  646.                 wks_pointer += (4 + wks:length) ! No - keep looking
  647.                 sta:wks_pointer = wks_pointer
  648.     .   .   .
  649.  
  650. read_text   ROUTINE     ! This reads the label data from the current record
  651.                         !   and checks to be sure it's coming from the correct
  652.                         !   cell location.  If the record is not valid, the
  653.                         !   file position pointer is not moved.
  654.     GET(wks_file,wks_pointer,9)         ! Get the label header
  655.     sta:wks_pointer = wks_pointer
  656.     IF (wks:col = cur_col)   AND |          ! Are we in the correct column (field)
  657.        (wks:row = cur_row)                  !   and row?
  658.         IF wks:opcode = label_op            ! Label record?
  659.             byte_cnt     = 4 + wks:length   ! Read the entire record, including the header
  660.             GET(wks_file,wks_pointer,byte_cnt)  ! Get the opcode, size, column, row, AND data
  661.             wks_pointer += byte_cnt         ! Advance the file pointer
  662.         ELSE
  663.             err_prefix = 'A numeric cell was found where a label cell was expected'
  664.             DO lookup_err
  665.         .
  666.     ELSE
  667.         wks:string = ''
  668.         IF wks:opcode = eof_op
  669.             wks_pointer = file_size + 1         ! All done
  670.     .   .
  671.  
  672. read_number ROUTINE     ! This reads the numeric data from the current record
  673.                         !   and checks to be sure it's coming from the correct
  674.                         !   cell location.  If the record is not valid, the
  675.                         !   file position pointer is not moved.
  676.     GET(wks_file,wks_pointer,9)         ! Get the label header
  677.     sta:wks_pointer = wks_pointer
  678.     IF (wks:col    = cur_col)   AND |   ! Are we in the correct column (field)
  679.        (wks:row    = cur_row)           !   and row?
  680.         CASE wks:opcode
  681.         OF integer_op                       ! Integer?
  682.             GET(wks_file,wks_pointer,11)    ! Get the integer record (size=7 + 4 byte header)
  683.             wks_pointer += 11               ! Advance the file pointer
  684.             wks_number = wks:integer
  685.         OF floating_op
  686.             GET(wks_file,wks_pointer,17)    ! Get the real number record (size=13 + 4 byte header)
  687.             wks_pointer += 17               ! Advance the file pointer
  688.             wks_number = wks:real_no
  689.         OF formula_op                       ! Formula
  690.             GET(wks_file,wks_pointer,17)    ! Get the real number result (size=13 + 4 byte header)
  691.             wks_pointer += 4 + wks:length   ! Advance the file pointer over the formula text (up to 2048 bytes)
  692.             wks_number = wks:real_no
  693. !       OF label_op                         ! Label - change to a number!
  694. !           byte_cnt     = 4 + wks:length       ! Read the entire record, including the header
  695. !           GET(wks_file,wks_pointer,byte_cnt)  ! Get the opcode, size, column, row, AND data
  696. !           wks_pointer += byte_cnt             ! Advance the file pointer
  697. !           wks_number   = SUB(wks:string,1, wks:length - 7)
  698.         ELSE
  699.             err_prefix = 'A label cell was found where a numeric cell was expected'
  700.             DO lookup_err
  701.         .
  702.     ELSE
  703.         wks_number = 0
  704.     .
  705.  
  706. abort_check     ROUTINE
  707.     LOOP UNTIL NOT KEYBOARD()                   ! Look for keystroke
  708.         ASK                                     ! Get keycode if there is one
  709.         IF (KEYCODE() = reject_key) OR |
  710.            (KEYCODE() = ctrl_esc)
  711.             BEEP
  712.             OPEN(msg_box); msg_text = 'Aborting.  Just a moment...'
  713.             DO cleanup
  714.             disp_msg('The importing was aborted as requested.')
  715.             RETURN
  716.     .   .
  717.  
  718. cleanup         ROUTINE
  719.     CLOSE(takeoff)                      ! Close the files
  720.     CLOSE(wks_file)
  721.     SHARE(takeoff)                      ! Reshare the takeoff file
  722.  
  723.     CLOSE(msg_box)                      ! Clear whatever message was displayed
  724.