home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a075 / 1.img / TOOLKIT1.EXE / SST173.PRG < prev    next >
Encoding:
Text File  |  1989-10-16  |  41.8 KB  |  1,313 lines
  1. ********************
  2.  
  3. PROCEDURE Reporter
  4.  
  5.    PARAMETERS which_sst, thru_what, macros_arr
  6.  
  7.    with_file = !(PCOUNT() = 0)
  8.    IF PCOUNT() = 1
  9.       thru_what = 1
  10.       IF TYPE("which_sst") = "A"
  11.          PUBLIC macplus[LEN(which_sst)+8]
  12.          ACOPY(which_sst, macplus, 1, LEN(which_sst), 9)
  13.          with_file = .F.
  14.       ELSE
  15.          PUBLIC macplus[8]
  16.       ENDIF
  17.       macplus[1] = "Double"
  18.       macplus[2] = "Single"
  19.       macplus[3] = "Begin Macro"
  20.       macplus[4] = "End Macro"
  21.       macplus[5] = "Hyphens"
  22.       macplus[6] = "Page No."
  23.       macplus[7] = "Date"
  24.       macplus[8] = "Time"
  25.    ELSEIF PCOUNT() = 2 .OR. PCOUNT() = 0
  26.       PUBLIC macplus[8]
  27.       macplus[1] = "Double"
  28.       macplus[2] = "Single"
  29.       macplus[3] = "Begin Macro"
  30.       macplus[4] = "End Macro"
  31.       macplus[5] = "Hyphens"
  32.       macplus[6] = "Page No."
  33.       macplus[7] = "Date"
  34.       macplus[8] = "Time"
  35.    ELSEIF PCOUNT() = 3
  36.       PUBLIC macplus[LEN(macros_arr)+8]
  37.       ACOPY(macros_arr, macplus, 1, LEN(macros_arr), 9)
  38.       macplus[1] = "Double"
  39.       macplus[2] = "Single"
  40.       macplus[3] = "Begin Macro"
  41.       macplus[4] = "End Macro"
  42.       macplus[5] = "Hyphens"
  43.       macplus[6] = "Page No."
  44.       macplus[7] = "Date"
  45.       macplus[8] = "Time"
  46.    ENDIF
  47.  
  48.    Wpush()
  49.  
  50.    IF with_file 
  51.       IF !FILE(which_sst + ".SST")
  52.          Wpop()
  53.          RETURN
  54.       ENDIF
  55.    ENDIF
  56.  
  57.    ret_area = LTRIM(TRIM(STR(SELECT())))
  58.  
  59.    filerthere = .F.
  60.    FOR _qaz = 1 TO 8
  61.       SELECT (_qaz)
  62.       IF !EMPTY(ALIAS())
  63.          filerthere = .T.
  64.       ENDIF
  65.    NEXT
  66.    SELECT &ret_area.
  67.  
  68.    IF !filerthere
  69.       @ 24,00
  70.       @ 24,00 SAY "No Files are available in the first 8 work areas!"
  71.       INKEY(0)
  72.       Wpop()
  73.       RETURN
  74.    ENDIF
  75.  
  76.    Savearray("Array1", allscreens)
  77.    Savearray("Array2", allcolor)
  78.    Savearray("Array3", allwindows)
  79.    
  80.    SAVE ALL LIKE * TO Holding.sys
  81.  
  82.    IF with_file
  83.       Init_rpt(which_sst, thru_what)
  84.    ELSE
  85.       Reporting()
  86.    ENDIF
  87.    Cleanrptup()
  88.    Wpop()
  89.  
  90. ********************
  91.  
  92. PROCEDURE Reporting
  93.  
  94.    **************************************************************
  95.    * ssthead1 - 6      The header for the reports               *
  96.    * sstfoot1 - 3      The footer for reports                   *
  97.    * sstcon1 - 12      The contents of the report               *
  98.    * sst_filter        The DO WHILE/FILTER for report           *
  99.    * sstfile                                                    *
  100.    * ssttotal1 - 3     The 3 total fields                       *
  101.    * ssthcnt           The # of lines to print for header       *
  102.    * sstfcnt           The # of lines to print for footer       *
  103.    * sstccnt           The # of lines to print for contents     *
  104.    * sst_f_str                                                  *
  105.    * sst_ndx                                                    *
  106.    * sst_t_file                                                 *
  107.    * sst_t_ndx                                                  *
  108.    * sstgroup          The field the GROUP is made on           *
  109.    * sstsgroup         The fields the SUB-GROUP is made on      *
  110.    * ssttotal1 - 3     The names of the fields for Grand Totals *
  111.    * sststot1 - 3      The names of the fields for Sub Totals   *
  112.    * sst_newg                                                   *
  113.    * sstgname          The name of the .GRP/INDEX file          *
  114.    **************************************************************
  115.  
  116.    STORE "" TO sst_f_str, sst_ndx, sst_t_file, sst_t_ndx, sstgroup, sstsgroup, ssttotal, sststot, sst_newg, sstgname
  117.    STORE "" TO ssthead1, ssthead2, ssthead3, ssthead4, ssthead5, ssthead6
  118.    STORE "" TO sstfoot1, sstfoot2, sstfoot3, sst_filter, sstfile
  119.    STORE "" TO sstcon1, sstcon2, sstcon3, sstcon4
  120.    STORE "" TO sstcon5, sstcon6, sstcon7, sstcon8
  121.    STORE "" TO sstcon9, sstcon10, sstcon11, sstcon12
  122.    STORE "" TO ssttotal1, ssttotal2, ssttotal3, sststot1, sststot2, sststot3
  123.  
  124.    STORE SPACE(132) TO ssthead1, ssthead2, ssthead3, ssthead4, ssthead5, ssthead6
  125.    STORE SPACE(132) TO sstfoot1, sstfoot2, sstfoot3, sstcon1, sstcon2, sstcon3, sstcon4
  126.    STORE SPACE(132) TO sstcon5, sstcon6, sstcon7, sstcon8, sstcon9, sstcon10, sstcon11, sstcon12
  127.    STORE SPACE(100) TO sst_filter
  128.    STORE SPACE(15) TO sstfile
  129.    STORE SPACE(10) TO ssttotal1, ssttotal2, ssttotal3, sststot1, sststot2, sststot3
  130.    STORE 6 TO ssthcnt
  131.    STORE 3 TO sstfcnt
  132.    STORE 12 TO sstccnt
  133.    STORE 1 TO rpt1, rpt21, print_way
  134.    STORE 0 TO sst_spec
  135.    STORE DTOC(DATE()) TO sstdate
  136.    STORE TIME() TO ssttime
  137.    STORE .F. TO sst_tog1, fromdisk
  138.    STORE "0" TO sstpage
  139.    SET SCOREBOARD OFF
  140.    SETCOLOR(IF((TYPE("scrcolor") = "U"), "", scrcolor))
  141.    CLEAR SCREEN
  142.  
  143.    ret_turn = STR(SELECT())
  144.    SELECT(0)
  145.    whatisit = SELECT()
  146.    SELECT &ret_turn.
  147.  
  148.    DECLARE in_files[whatisit]
  149.    AFILL(in_files, "")
  150.    IF TYPE("scrleft_1") = "U" .OR. TYPE("scrleft_2") = "U"
  151.       @ 0,0 SAY "ToolkiT(tm) / On-Line Reporter"
  152.  
  153.    ELSEIF scrleft_1 = "Steve Straley's ToolkiT"
  154.       @ 0,0 SAY scrleft_1 + " / " + scrleft_2
  155.  
  156.    ELSE
  157.       @ 0,0 SAY scrleft_1 + scrleft_2
  158.  
  159.    ENDIF
  160.    @ 0,59 SAY "ESC for Previous Menu"
  161.    Wpush(1,0,8,14,3)
  162.    DO WHILE .T.
  163.       STORE TIME() TO ssttime
  164.       Rpt_stat()
  165.       Reset()
  166.       yes_quit = .F.
  167.       rpt1 = Makemenu("Files/Condition/Design/Generate/Utilities/Quit", Wrow(1),Wcol(1),rpt1,3, .T.)
  168.       IF EMPTY(rpt1)
  169.          KEYBOARD "Q"
  170.          LOOP
  171.       ENDIF
  172.       brch = TRANSFORM(rpt1, "9")
  173.       DO Reporter&brch.
  174.       IF yes_quit
  175.          EXIT
  176.       ENDIF
  177.    ENDDO
  178.    Wpop()
  179.    STORE "" TO sst_f_str, sst_ndx, sst_t_file, sst_t_ndx, sstgroup, sstsgroup, ssttotal, sststot, sst_newg, sstgname
  180.    STORE "" TO ssthead1, ssthead2, ssthead3, ssthead4, ssthead5, ssthead6
  181.    STORE "" TO sstfoot1, sstfoot2, sstfoot3, sst_filter, sstfile
  182.    STORE "" TO sstcon1, sstcon2, sstcon3, sstcon4
  183.    STORE "" TO sstcon5, sstcon6, sstcon7, sstcon8
  184.    STORE "" TO sstcon9, sstcon10, sstcon11, sstcon12
  185.    STORE "" TO ssttotal1, ssttotal2, ssttotal3, sststot1, sststot2, sststot3
  186.    RELEASE sst_f_str, sst_ndx, sst_t_file, sst_t_ndx, sstgroup, sstsgroup, ssttotal, sststot, sst_newg, sstgname
  187.    RELEASE ssthead1, ssthead2, ssthead3, ssthead4, ssthead5, ssthead6
  188.    RELEASE sstfoot1, sstfoot2, sstfoot3, sst_filter, sstfile
  189.    RELEASE sstcon1, sstcon2, sstcon3, sstcon4
  190.    RELEASE sstcon5, sstcon6, sstcon7, sstcon8
  191.    RELEASE sstcon9, sstcon10, sstcon11, sstcon12
  192.    RELEASE ssttotal1, ssttotal2, ssttotal3, sststot1, sststot2, sststot3
  193.  
  194. ********************
  195.  
  196. PROCEDURE Reporter1
  197.  
  198.    IF EMPTY(sst_f_str) .OR. fromdisk
  199.       IF Set_files()
  200.          _oldcolor = SETCOLOR()
  201.          SETCOLOR(Reverse())
  202.          @ 24,00 SAY "No Files Are Available!"
  203.          INKEY(0)
  204.          SETCOLOR(_oldcolor)
  205.          @ 24,00
  206.          KEYBOARD "QY" + CHR(13)
  207.          RETURN
  208.       ENDIF
  209.    ENDIF
  210.    rpt21 = 1
  211.    Wpush(3, 4, (Occurence("/", sst_f_str) + 5), 20, 3)
  212.    DO WHILE .T.
  213.       Rpt_stat()
  214.       Withquit(.T.)
  215.       rpt21 = Makemenu(sst_f_str, Wrow(1), Wcol(1), rpt21, 1,.T.,1,12,11)
  216.       Withquit(.F.)
  217.       IF rpt21 = 0
  218.          EXIT
  219.       ENDIF
  220.       IF fromdisk
  221.          @ 24,00
  222.          @ 24,00 SAY "You must CLEAR out the system before selecting!"
  223.          INKEY(0)
  224.          @ 24,00
  225.          LOOP
  226.       ENDIF
  227.       sst_t_file = in_files[rpt21]
  228.       sst_filter = ""
  229.       SELECT &sst_t_file.
  230.       sst_t_ndx = ""
  231.       IF !EMPTY(INDEXORD())
  232.          List_ndx(rpt21)
  233.       ENDIF
  234.    ENDDO
  235.    Wpop()
  236.  
  237. ********************
  238.  
  239. PROCEDURE Reporter2
  240.  
  241.    STORE 1 TO rpt22
  242.  
  243.    IF !EMPTY(sst_filter)
  244.       sst_filter = STRTRAN(STRTRAN(STRTRAN(sst_filter, ".AND. !EOF()", ""), " .AND. CONTINUE()"), "!EOF()", "")
  245.       sst_filter = LTRIM(TRIM(sst_filter))
  246.       ttqwrr = SUBSTR(sst_filter, LEN(sst_filter) - 6)
  247.       IF ".AND."$ttqwrr
  248.          sst_filter = SUBSTR(sst_filter, 1, LEN(sst_filter) - 5)
  249.       ENDIF
  250.       sst_filter = FILL_OUT(sst_filter, 100)
  251.    ELSE
  252.       sst_filter = SPACE(100)
  253.    ENDIF
  254.    Wpush(4,31,14,70,3)
  255.    @ Wrow(), Wcol(2) SAY " Report on this condition - F1=Help "
  256.    Wpush(4,4,15,21, 3)                     && For all else
  257.    Reset(.T.)
  258.    DO WHILE .T.
  259.       returning = ""
  260.       STORE 1 TO rpt221
  261.       Rpt_stat()
  262.       KEYBOARD CHR(27)
  263.       MEMOEDIT(sst_filter,5,33,13,68,.F.)
  264.       KEYBOARD ""
  265.       do_get = .F.
  266.       no_edit = .T.
  267.       rpt22 = Makemenu("Fields/Dates/Numbers/Strings/Conjunctions/File/Operations/EDIT/REMOVE/Quit",Wrow(1),Wcol(1),rpt22,1)
  268.       DO CASE
  269.       CASE rpt22 = 1
  270.          returning = Fields_in(0, 5+rpt22,8)
  271.       CASE rpt22 = 2
  272.          returning = Dates_in()
  273.       CASE rpt22 = 3
  274.          returning = Number_in()
  275.       CASE rpt22 = 4
  276.          returning = String_in()
  277.       CASE rpt22 = 5
  278.          returning = Junct_in()
  279.       CASE rpt22 = 6
  280.          returning = Dbase_in()
  281.       CASE rpt22 = 7
  282.          returning = Operat_in()
  283.       CASE rpt22 = 8
  284.          _oldcolor = SETCOLOR()
  285.          SETCOLOR(Reverse())
  286.          sst_filter = STRTRAN(STRTRAN(MEMOEDIT(sst_filter,5,33,13,68,.T.,"Rpthelp1"), CHR(141)+CHR(10), ""), CHR(13) + CHR(10) + "")
  287.          SETCOLOR(_oldcolor)
  288.          returning = ""
  289.          do_get = .T.
  290.          no_edit = .F.
  291.       CASE rpt22 = 9
  292.          sst_filter = SPACE(100)
  293.       OTHERWISE
  294.          EXIT
  295.       ENDCASE
  296.       returning = IF(LASTKEY() = 27, "", returning)
  297.       IF !EMPTY(returning)
  298.          sst_filter = Fill_out(LTRIM(TRIM(sst_filter)) + returning, 100)
  299.       ENDIF
  300.    ENDDO
  301.    Reset()
  302.    Wpop()
  303.    Wpop()
  304.  
  305. ********************
  306.  
  307. FUNCTION Rpthelp1
  308.  
  309.    IF LASTKEY() = 28
  310.       _wcolor = SETCOLOR()
  311.       SETCOLOR(Reverse())
  312.       Wpush(6,35,12,65)
  313.       @ Wrow(1), Wcol(5), "F1 is this Key"
  314.       @ Wrow(2), Wcol(5), "F10 to SAVE the editing"
  315.       @ Wrow(3), Wcol(5), "ESC to Exit"
  316.       @ Wrow(5), Wcol(5), "Any key to continue..."
  317.       INKEY(0)
  318.       Wpop()
  319.       SETCOLOR(_wcolor)
  320.  
  321.    ELSEIF LASTKEY() = 27
  322.       RETURN(27)
  323.  
  324.    ELSEIF LASTKEY() = -9
  325.       KEYBOARD CHR(23)
  326.       RETURN(0)
  327.  
  328.    ELSEIF LASTKEY() = 23
  329.       RETURN(0)
  330.  
  331.    ELSEIF LASTKEY() = 2
  332.       RETURN(100)
  333.  
  334.    ENDIF
  335.    RETURN(32)
  336.  
  337. ********************
  338.  
  339. PROCEDURE Reporter3
  340.  
  341.    rpt23 = 1
  342.    Wpush(5, 6, 11, 21)
  343.    Reset(.T.)
  344.    DO WHILE .T.
  345.       disp_1 = "TAB for macros/special characters"
  346.       rpt231 = 1
  347.       Rpt_stat()
  348.       rpt23 = Makemenu("Report/Group On/Totals On/Subtotal on/Quit", Wrow(1),Wcol(1),rpt23,3,.T.,1,20,12)
  349.       DO CASE
  350.       CASE rpt23 = 1
  351.          Pushscreen()
  352.          Palate()
  353.          SET KEY 9 TO Special
  354.          SET KEY 271 TO Show_file
  355.          SET KEY 22 TO Change_ins
  356.          SET KEY  3 TO
  357.          SET KEY 18 TO
  358.          KEYBOARD CHR(23)
  359.          Insert_tog(24,70,!READINSERT())
  360.          reportstr = "....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+....0....+....1....+....2....+....3" + CHR(141) + CHR(10)
  361.          reportstr = reportstr + SUBSTR(Fill_out(ssthead1, 130), 1, 130) + CHR(141)+CHR(10)
  362.          reportstr = reportstr + SUBSTR(Fill_out(ssthead2, 130), 1, 130) + CHR(141)+CHR(10)
  363.          reportstr = reportstr + SUBSTR(Fill_out(ssthead3, 130), 1, 130) + CHR(141)+CHR(10)
  364.          reportstr = reportstr + SUBSTR(Fill_out(ssthead4, 130), 1, 130) + CHR(141)+CHR(10)
  365.          reportstr = reportstr + SUBSTR(Fill_out(ssthead5, 130), 1, 130) + CHR(141)+CHR(10)
  366.          reportstr = reportstr + SUBSTR(Fill_out(ssthead6, 130), 1, 130) + CHR(141)+CHR(10)
  367.          reportstr = reportstr + SUBSTR(Fill_out(sstcon1, 130), 1, 130) + CHR(141) + CHR(10)
  368.          reportstr = reportstr + SUBSTR(Fill_out(sstcon2, 130), 1, 130) + CHR(141) + CHR(10)
  369.          reportstr = reportstr + SUBSTR(Fill_out(sstcon3, 130), 1, 130) + CHR(141) + CHR(10)
  370.          reportstr = reportstr + SUBSTR(Fill_out(sstcon4, 130), 1, 130) + CHR(141) + CHR(10)
  371.          reportstr = reportstr + SUBSTR(Fill_out(sstcon5, 130), 1, 130) + CHR(141) + CHR(10)
  372.          reportstr = reportstr + SUBSTR(Fill_out(sstcon6, 130), 1, 130) + CHR(141) + CHR(10)
  373.          reportstr = reportstr + SUBSTR(Fill_out(sstcon7, 130), 1, 130) + CHR(141) + CHR(10)
  374.          reportstr = reportstr + SUBSTR(Fill_out(sstcon8, 130), 1, 130) + CHR(141) + CHR(10)
  375.          reportstr = reportstr + SUBSTR(Fill_out(sstcon9, 130), 1, 130) + CHR(141) + CHR(10)
  376.          reportstr = reportstr + SUBSTR(Fill_out(sstcon10, 130), 1, 130) + CHR(141) + CHR(10)
  377.          reportstr = reportstr + SUBSTR(Fill_out(sstcon11, 130), 1, 130) + CHR(141) + CHR(10)
  378.          reportstr = reportstr + SUBSTR(Fill_out(sstcon12, 130), 1, 130) + CHR(141) + CHR(10)
  379.          reportstr = reportstr + SUBSTR(Fill_out(sstfoot1, 130), 1, 130) + CHR(141)+CHR(10)
  380.          reportstr = reportstr + SUBSTR(Fill_out(sstfoot2, 130), 1, 130) + CHR(141)+CHR(10)
  381.          reportstr = reportstr + SUBSTR(Fill_out(sstfoot3, 130), 1, 130) + CHR(141)+CHR(10)
  382.          @  2, 2 SAY "  Header 1 =>" 
  383.          @  3, 2 SAY "         2 =>" 
  384.          @  4, 2 SAY "         3 =>" 
  385.          @  5, 2 SAY "         4 =>" 
  386.          @  6, 2 SAY "         5 =>" 
  387.          @  7, 2 SAY "         6 =>" 
  388.          @  8, 2 SAY "Contents 1 =>" 
  389.          @  9, 2 SAY "         2 =>" 
  390.          @ 10, 2 SAY "         3 =>" 
  391.          @ 11, 2 SAY "         4 =>" 
  392.          @ 12, 2 SAY "         5 =>" 
  393.          @ 13, 2 SAY "         6 =>" 
  394.          @ 14, 2 SAY "         7 =>" 
  395.          @ 15, 2 SAY "         8 =>" 
  396.          @ 16, 2 SAY "         9 =>" 
  397.          @ 17, 2 SAY "        10 =>" 
  398.          @ 18, 2 SAY "        11 =>" 
  399.          @ 19, 2 SAY "        12 =>" 
  400.          @ 20, 2 SAY "  Footer 1 =>" 
  401.          @ 21, 2 SAY "         2 =>" 
  402.          @ 22, 2 SAY "         3 =>" 
  403.          @ 23, 2 SAY "TAB for Macros - SHIFT TAB for fields - Maximum Width is 132 "
  404.          SETCOLOR(Reverse())
  405.          reportstr = HARDCR(MEMOEDIT(reportstr, 1, 16, 22, 75, .T., "Repkeys", 131))
  406.          Parsing(@reportstr, CHR(13)+CHR(10) )   && The first one for the banner
  407.  
  408.          ssthead1 = Fill_out(Parsing(@reportstr, CHR(13)+CHR(10) ), 130)
  409.          ssthead2 = Fill_out(Parsing(@reportstr, CHR(13)+CHR(10) ), 130)
  410.          ssthead3 = Fill_out(Parsing(@reportstr, CHR(13)+CHR(10) ), 130)
  411.          ssthead4 = Fill_out(Parsing(@reportstr, CHR(13)+CHR(10) ), 130)
  412.          ssthead5 = Fill_out(Parsing(@reportstr, CHR(13)+CHR(10) ), 130)
  413.          ssthead6 = Fill_out(Parsing(@reportstr, CHR(13)+CHR(10) ), 130)
  414.          sstcon1  = Fill_out(Parsing(@reportstr, CHR(13)+CHR(10) ), 130)
  415.          sstcon2  = Fill_out(Parsing(@reportstr, CHR(13)+CHR(10) ), 130)
  416.          sstcon3  = Fill_out(Parsing(@reportstr, CHR(13)+CHR(10) ), 130)
  417.          sstcon4  = Fill_out(Parsing(@reportstr, CHR(13)+CHR(10) ), 130)
  418.          sstcon5  = Fill_out(Parsing(@reportstr, CHR(13)+CHR(10) ), 130)
  419.          sstcon6  = Fill_out(Parsing(@reportstr, CHR(13)+CHR(10) ), 130)
  420.          sstcon7  = Fill_out(Parsing(@reportstr, CHR(13)+CHR(10) ), 130)
  421.          sstcon8  = Fill_out(Parsing(@reportstr, CHR(13)+CHR(10) ), 130)
  422.          sstcon9  = Fill_out(Parsing(@reportstr, CHR(13)+CHR(10) ), 130)
  423.          sstcon10 = Fill_out(Parsing(@reportstr, CHR(13)+CHR(10) ), 130)
  424.          sstcon11 = Fill_out(Parsing(@reportstr, CHR(13)+CHR(10) ), 130)
  425.          sstcon12 = Fill_out(Parsing(@reportstr, CHR(13)+CHR(10) ), 130)
  426.          sstfoot1 = Fill_out(Parsing(@reportstr, CHR(13)+CHR(10) ), 130)
  427.          sstfoot2 = Fill_out(Parsing(@reportstr, CHR(13)+CHR(10) ), 130)
  428.          sstfoot3 = Fill_out(Parsing(@reportstr, CHR(13)+CHR(10) ), 130)
  429.          SET KEY   3 TO 
  430.          SET KEY   9 TO 
  431.          SET KEY 271 TO 
  432.          SET KEY  22 TO 
  433.          Popscreen()
  434.  
  435.       CASE rpt23 = 2                                && Group on
  436.          @ 18, 45 SAY "ESC Key Turns OFF"
  437.          sstgroup = Fields_in(0, 4, 24)
  438.          IF EMPTY(sstgname)
  439.             sstgname = "NONAME"
  440.          ENDIF
  441.          IF LASTKEY() <> 27
  442.             IF !EMPTY(sst_t_ndx)
  443.                ndxstring = STRTRAN(NDXSTRVAL(sstgroup), '"') + " + " + sst_t_ndx
  444.             ELSE
  445.                ndxstring = STRTRAN(NDXSTRVAL(sstgroup), '"')
  446.             ENDIF
  447.             IF TYPE(ndxstring) != "U" .OR. TYPE(ndxstring) != "UE"
  448.                IF !EMPTY(sst_t_file)
  449.                   @ 23,00 SAY "One Moment to Re-Group!"
  450.                   INDEX ON &ndxstring. TO (sstgname + ".grp")
  451.                   @ 23,00
  452.                ENDIF
  453.             ENDIF
  454.           ENDIF
  455.           @ 18, 45, SPACE(20)
  456.       CASE rpt23 = 3
  457.          Wpush(Wrow(4), 8, Wrow(4)+4, 23)
  458.          DO WHILE .T.
  459.             Withquit(.T.)
  460.             rpt231 = Makemenu(ssttotal1 + "/" + ssttotal2 + "/" + ssttotal3, Wrow(1),Wcol(1), rpt231,1,.T.)
  461.             Withquit(.F.)
  462.             DO CASE
  463.             CASE rpt231 = 0
  464.                EXIT
  465.             OTHERWISE
  466.                eext = LTRIM(TRIM(STR(rpt231)))
  467.                in_dummy = FIELDS_IN(2, 4, 26)
  468.                IF LASTKEY() <> 27
  469.                   ssttotal&eext. = in_dummy
  470.                ENDIF
  471.             ENDCASE
  472.          ENDDO
  473.          Wpop()
  474.       CASE rpt23 = 4
  475.          Wpush(Wrow(5), 8, Wrow(5)+4, 23)
  476.          DO WHILE .T.
  477.             Withquit(.T.)
  478.             rpt231 = Makemenu(sststot1 + "/" + sststot2 + "/" + sststot3, Wrow(1),Wcol(1),rpt231, 1, .T.)
  479.             Withquit(.F.)
  480.             DO CASE
  481.             CASE rpt231 = 0
  482.                EXIT
  483.             OTHERWISE
  484.                eext = LTRIM(TRIM(STR(rpt231)))
  485.                in_dummy = FIELDS_IN(2, 4, 26)
  486.                IF LASTKEY() <> 27
  487.                   sststot&eext. = in_dummy
  488.                ENDIF
  489.             ENDCASE
  490.          ENDDO
  491.          Wpop()
  492.       OTHERWISE
  493.          EXIT
  494.       ENDCASE
  495.    ENDDO
  496.    Reset()
  497.    Wpop()
  498.  
  499. ********************
  500.  
  501. FUNCTION Repkeys
  502.  
  503.    PARAMETERS _mode, _row, _col
  504.  
  505.    IF _row = 1
  506.       KEYBOARD CHR(24)
  507.    ENDIF
  508.  
  509.    IF _col > 130 .AND. _row = 22
  510.       KEYBOARD CHR(8)
  511.    ENDIF
  512.  
  513.    IF _row >= 23
  514.       KEYBOARD REPLICATE(CHR(5), 22) + REPLICATE(CHR(24), 21)
  515.    ENDIF
  516.  
  517.    RETURN(0)
  518.  
  519. ********************
  520.  
  521. PROCEDURE Change_ins
  522.  
  523.    PARAMETERS p, l, v
  524.  
  525.    Insert_tog(24,70,.T.)
  526.  
  527. ********************
  528.  
  529. PROCEDURE Complete
  530.  
  531.    PARAMETERS p, l, v
  532.  
  533.    togo = VAL(SUBSTR(v, 7))
  534.    KEYBOARD REPLICATE(CHR(13), 12 - togo + 1)
  535.  
  536.  
  537. ********************
  538.  
  539. PROCEDURE Reporter4
  540.  
  541.    rpt24 = 1
  542.    IF TYPE("nocode") = "U"
  543.       Wpush(6,6,12,18)
  544.    ELSE
  545.       Wpush(6,6,11,18)
  546.    ENDIF
  547.    DO WHILE .T.
  548.       Rpt_stat()
  549.       Reset()
  550.       IF TYPE("nocode") = "U"
  551.          rpt24 = Makemenu("Screen/Printer/File/Code/Quit", Wrow(1), Wcol(1),rpt24,3,.T.,1,20,9)
  552.       ELSE
  553.          rpt24 = Makemenu("Screen/Printer/File/Quit", Wrow(1), Wcol(1),rpt24,3,.T.,1,20,9)
  554.       ENDIF
  555.       Reset(.T.)
  556.       IF TYPE("nocode") = "U"
  557.          IF rpt24 = 0 .OR. rpt24 = 5
  558.             EXIT
  559.          ENDIF
  560.       ELSE
  561.          IF rpt24 = 0 .OR. rpt24 = 4
  562.             EXIT
  563.          ENDIF
  564.       ENDIF
  565.  
  566.       DO CASE
  567.       CASE rpt24 = 4
  568.          Wpush(Wrow(5), Wcol(2), Wrow(7), Wcol(2) + 44)
  569.          @ Wrow(1),Wcol(1) SAY "Enter Program/File Name =" GET sstfile PICT "@!@K" VALID !FILE(TRIM(sstfile) + IF(AT(".", sstfile) = 0, ".PRG", ""))
  570.          READ
  571.          Wpop()
  572.          IF LASTKEY() = 27
  573.             LOOP
  574.          ENDIF
  575.          Wpush(Wrow(5), Wcol(2), Wrow(7), Wcol(2) + 42)
  576.          @ Wrow(1),Wcol(1) SAY "Writing Code Section.  One Moment Please!"
  577.          SET CONSOLE OFF
  578.          Gen_code()
  579.          RENAME (sstfile + ".TXT") TO (sstfile + ".prg")
  580.          SET CONSOLE ON
  581.          Wpop()
  582.       OTHERWISE
  583.          IF rpt24 = 3
  584.             Wpush(Wrow(4), Wcol(2), Wrow(7), Wcol(2) + 36)
  585.             DO WHILE .T.
  586.                @ Wrow(1),Wcol(1) SAY "Enter File Name =>" GET sstfile PICT "@!" 
  587.                READ
  588.                IF LASTKEY() = 27
  589.                   EXIT
  590.                ENDIF
  591.                IF FILE(TRIM(sstfile) + IF(AT(".", sstfile) = 0, ".TXT", ""))
  592.                   @ Wrow(2), Wcol(1) SAY "File Exists.  Try Again or ESC"
  593.                ELSE
  594.                   EXIT
  595.                ENDIF
  596.             ENDDO
  597.             Wpop()
  598.          ENDIF
  599.          IF LASTKEY() = 27
  600.             LOOP
  601.          ENDIF
  602.          print_file = sstfile
  603.          Pushscreen()
  604.          Gen_report(rpt24)
  605.          Popscreen()
  606.          IF rpt24 = 3   && Don't adjust this....
  607.             scr_level = scr_level - 1
  608.          ENDIF
  609.       ENDCASE
  610.    ENDDO
  611.    Wpop()
  612.  
  613. ********************
  614.  
  615. PROCEDURE Reporter5
  616.  
  617.    STORE 1 TO rpt15, rpt151
  618.    Wpush(7,6,17,25)
  619.    Rpt_stat()
  620.    DO WHILE .T.
  621.       Reset()
  622.       rpt15 = Makemenu("Empty System/Restore Report/Save Report/Printer Controls/Header Lines/Footer Lines/Content Lines/Toggles/Quit", Wrow(1), Wcol(1),rpt15,3,.T.)
  623.       Reset(.T.)
  624.       DO CASE
  625.       CASE rpt15 = 1
  626.  
  627.          **********************************************************
  628.          * ssthead1 - 6      The header for the reports           *
  629.          * sstfoot1 - 3      The footer for reports               *
  630.          * sstcon1 - 12      The contents of the report           *
  631.          * sst_filter        The DO WHILE/FILTER for report       *
  632.          * sstfile                                                *
  633.          * ssttotal1 - 3     The 3 total fields                   *
  634.          * ssthcnt           The # of lines to print for header   *
  635.          * sstfcnt           The # of lines to print for footer   *
  636.          * sstccnt           The # of lines to print for contents *
  637.          * sst_f_str                                              *
  638.          * sst_ndx                                                *
  639.          * sst_t_file                                             *
  640.          * sst_t_ndx                                              *
  641.          * sstgroup          The field the GROUP is made on       *
  642.          * sstsgroup         The fields the SUB-GROUP is made on  *
  643.          * ssttotal                                               *
  644.          * sststot                                                *
  645.          * sst_newg                                               *
  646.          * sstgname          The name of the .GRP/INDEX file      *
  647.          **********************************************************
  648.  
  649.          STORE "" TO sst_f_str, sst_ndx, sst_t_file, sst_t_ndx, sstgroup, sstsgroup, ssttotal, sststot, sst_newg, sstgname
  650.          STORE SPACE(132) TO ssthead1, ssthead2, ssthead3, ssthead4, ssthead5, ssthead6
  651.          STORE SPACE(132) TO sstfoot1, sstfoot2, sstfoot3, sstcon1, sstcon2, sstcon3, sstcon4
  652.          STORE SPACE(132) TO sstcon5, sstcon6, sstcon7, sstcon8, sstcon9, sstcon10, sstcon11, sstcon12
  653.          STORE SPACE(100) TO sst_filter
  654.          STORE SPACE(15) TO sstfile
  655.          STORE SPACE(10) TO ssttotal1, ssttotal2, ssttotal3
  656.          STORE 6 TO ssthcnt
  657.          STORE 3 TO sstfcnt
  658.          STORE 12 TO sstccnt
  659.          STORE 0 TO sst_spec
  660.          STORE DTOC(DATE()) TO sstdate
  661.          STORE TIME() TO ssttime
  662.          STORE "0" TO sstpage
  663.          STORE .F. TO sst_tog1, fromdisk
  664.          Rpt_stat()
  665.  
  666.       CASE rpt15 = 2
  667.          Wpush(Wrow(3), 8, Wrow(6), 52)
  668.          DO WHILE .T.
  669.             SET KEY ASC("?") TO Showsst
  670.             get_file = SPACE(14)
  671.             @ Wrow(3), Wcol(2) SAY " ? to Inquire "
  672.             @ Wrow(1), Wcol(2) SAY "Enter File Name =>" GET get_file PICT "@K@!" VALID !(LASTKEY() = ASC("?"))
  673.             READ
  674.             SET KEY ASC("?") TO
  675.             IF LASTKEY() = 27 .OR. EMPTY(get_file)
  676.                EXIT
  677.             ENDIF
  678.             Clear_area()
  679.             IF !FILE(TRIM(get_file) + ".SST")
  680.                @ Wrow(2), Wcol(2) SAY "That is NOT on file...."
  681.             ELSE
  682.                RESTORE FROM (TRIM(get_file) + ".sst") ADDITIVE
  683.                AFILL(in_files, "")
  684.                toggle = .F.
  685.                FOR x = 1 TO LEN(in_files)
  686.                   SELECT (x)
  687.                   IF !EMPTY(ALIAS())
  688.                      in_files[x] = ALIAS()
  689.                   ENDIF
  690.                NEXT
  691.                * the previous code may appear to be duplicated
  692.                * but because of the special testing condition within
  693.                * the next FOR loop, I wanted to play safe and
  694.                * just stuff the array as expected.
  695.                FOR x = 1 TO LEN(in_files)
  696.                   SELECT (x)
  697.                   IF !EMPTY(ALIAS())
  698.                      IF ALIAS() = sst_t_file
  699.                         fromdisk = .T.
  700.                         toggle = .T.
  701.                         EXIT
  702.                      ENDIF
  703.                   ENDIF
  704.                NEXT
  705.  
  706.                IF toggle .AND. !EMPTY(sst_t_file)
  707.                   SELECT &sst_t_file.
  708.                   Rpt_stat()
  709.                ELSE
  710.                   @ 24,00
  711.                   @ 24,01 SAY " Files ARE Not Available.  Error Condition.  Any Key!!!"
  712.                   INKEY(0)
  713.                   KEYBOARD "E"
  714.                   EXIT
  715.                ENDIF
  716.                ssthead1 = Fill_out(ssthead1 , 130)
  717.                ssthead2 = Fill_out(ssthead2 , 130)
  718.                ssthead3 = Fill_out(ssthead3 , 130)
  719.                ssthead4 = Fill_out(ssthead4 , 130)
  720.                ssthead5 = Fill_out(ssthead5 , 130)
  721.                ssthead6 = Fill_out(ssthead6 , 130)
  722.                sstfoot1 = Fill_out(sstfoot1 , 130)
  723.                sstfoot2 = Fill_out(sstfoot2 , 130)
  724.                sstfoot3 = Fill_out(sstfoot3 , 130)
  725.                sstcon1  = Fill_out(sstcon1  , 130)
  726.                sstcon2  = Fill_out(sstcon2  , 130)
  727.                sstcon3  = Fill_out(sstcon3  , 130)
  728.                sstcon4  = Fill_out(sstcon4  , 130)
  729.                sstcon5  = Fill_out(sstcon5  , 130)
  730.                sstcon6  = Fill_out(sstcon6  , 130)
  731.                sstcon7  = Fill_out(sstcon7  , 130)
  732.                sstcon8  = Fill_out(sstcon8  , 130)
  733.                sstcon9  = Fill_out(sstcon9  , 130)
  734.                sstcon10 = Fill_out(sstcon10 , 130)
  735.                sstcon11 = Fill_out(sstcon11 , 130)
  736.                sstcon12 = Fill_out(sstcon12 , 130)
  737.  
  738.                IF !EMPTY(sstgname)
  739.                   IF FILE(sstgname + ".GRP")
  740.                      RUN REN &sstgname..grp Noname.grp
  741.                   ELSE
  742.                      sstgname = LTRIM(TRIM(get_file))
  743.                   ENDIF
  744.                 ENDIF
  745.                 EXIT
  746.             ENDIF
  747.          ENDDO 
  748.          Wpop()
  749.       CASE rpt15 = 3
  750.          go_file = "        "
  751.          Wpush(Wrow(4),8, Wrow(7),48)
  752.          DO WHILE .T.
  753.             @ Wrow(1), Wcol(2) SAY "Enter File Name =>" GET go_file PICT "@!"
  754.             READ
  755.             sstgname = TRIM(go_file)
  756.             IF FILE("NONAME.GRP")
  757.                RUN REN Noname.grp &sstgname..grp
  758.             ENDIF
  759.             IF LASTKEY() = 27 .OR. EMPTY(go_file)
  760.                EXIT
  761.             ENDIF
  762.             IF !FILE(TRIM(go_file) + ".SST")
  763.                fhandle = FCREATE(TRIM(go_file))
  764.                IF fhandle > 4
  765.                   FCLOSE(fhandle)
  766.                   SAVE ALL LIKE sst* TO (TRIM(go_file) + ".sst")
  767.                   EXIT
  768.                ENDIF
  769.             ELSE
  770.                @ Wrow(2), Wcol(2) SAY "Already Exists.  Overwrite? "
  771.                IF Prompt()
  772.                   SAVE ALL LIKE sst* TO (go_file + ".sst")
  773.                   EXIT
  774.                ENDIF
  775.             ENDIF
  776.          ENDDO
  777.          Wpop()
  778.       CASE rpt15 = 4
  779.          Wpush(Wrow(3),20,Wrow(3)+13,37)
  780.          DO WHILE .T.
  781.             rpt151 = Makemenu("Printer Status/Condense/Bold/Normal/Italic/Wide/Pica/Elite/Emphasize/Underline/Quit",Wrow(1),Wcol(1),rpt151,3,.T.)
  782.             DO CASE
  783.             CASE rpt151 = 0
  784.                EXIT
  785.             CASE rpt151 = 1
  786.                Wpush(10,10,12,70)
  787.                @ Wrow(1), Wcol(2) SAY IF( ISPRINTER(), "The Printer is On-Line and Ready....   Any key to continue", "  Your Printer is NOT ready!    Any key to continue")
  788.                INKEY(0)
  789.                Wpop()
  790.             OTHERWISE
  791.                Wpush(17,20,19,55)
  792.                IF ISPRINTER()
  793.                   @ Wrow(1), Wcol(2) SAY "Initializing Printer..."
  794.                   SET PRINTER ON
  795.                   SET CONSOLE OFF
  796.                   DO CASE
  797.                   CASE rpt151 = 2    && Condense
  798.                      ?? CHR(27) + CHR(15)
  799.                   CASE rpt151 = 3    && Bold
  800.                      ?? CHR(27) + "G"
  801.                   CASE rpt151 = 4    && Normal
  802.                      ?? CHR(27) + "@"
  803.                   CASE rpt151 = 5    && Italic
  804.                      ?? CHR(27) + "4"
  805.                   CASE rpt151 = 6    && Wide
  806.                      ?? CHR(27) + "W1"
  807.                   CASE rpt151 = 7    && Pica
  808.                      ?? CHR(27) + "P"
  809.                   CASE rpt151 = 8    && Elite
  810.                      ?? CHR(27) + "M"
  811.                   CASE rpt151 = 9    && Emphasize
  812.                      ?? CHR(27) + "E" 
  813.                   CASE rpt151 = 10   && Underline 
  814.                      ?? CHR(27) + "-1"
  815.                   ENDCASE
  816.                   SETPRC(0,0)
  817.                   SET PRINTER OFF
  818.                   SET CONSOLE ON
  819.                ELSE
  820.                   @ Wrow(1), Wcol(2) SAY " Printer Not on line. Any Key!!"
  821.                   INKEY(0)
  822.                ENDIF
  823.                Wpop()
  824.             ENDCASE
  825.          ENDDO
  826.          Wpop()
  827.       CASE rpt15 >= 5 .AND. rpt15 <= 8
  828.          Wpush(Wrow(1)+rpt15, 9, Wrow(3)+rpt15, 48)
  829.          IF     rpt15 = 5
  830.             @ Wrow(1), Wcol(2) SAY "Number of Header Lines => " GET ssthcnt PICT "#" VALID(ssthcnt >= 0 .AND. ssthcnt <= 6)
  831.             READ
  832.          ELSEIF rpt15 = 6
  833.             @ Wrow(1), Wcol(2) SAY "Number of Footer Lines => " GET sstfcnt PICT "#" VALID(sstfcnt >= 0 .AND. sstfcnt <= 6)
  834.             READ
  835.          ELSEIF rpt15 = 7
  836.             @ Wrow(1), Wcol(2) SAY "Number of Content Lines => " GET sstccnt PICT "##" VALID(sstccnt >= 0 .AND. sstccnt <= 12)
  837.             READ
  838.          ELSE
  839.             @ Wrow(1),Wcol(2) SAY " Total without Printing?      "
  840.             @ Wrow(1),Wcol(28) SAY ""
  841.             sst_tog1 = !Prompt()
  842.          ENDIF
  843.          Wpop()
  844.       OTHERWISE
  845.          EXIT
  846.       ENDCASE
  847.    ENDDO
  848.    Wpop()
  849.  
  850. ********************
  851.  
  852. PROCEDURE Showsst
  853.  
  854.    IF EMPTY(ADIR("*.sst"))
  855.       Wpush(7,50,10,76)
  856.       @ Wrow(1), Wcol(1), "No Report Files on disk."
  857.       @ Wrow(2), Wcol(1), "Press any key to move on."
  858.       INKEY(0)
  859.       Wpop()
  860.    ELSE
  861.       DECLARE tempsst[ADIR("*.sst")]
  862.       ADIR("*.sst", tempsst)
  863.       get_file = Apick(Apop(4,50,16,20,tempsst,.T.), tempsst)
  864.       RELEASE tempsst
  865.    ENDIF
  866.  
  867. ********************
  868.  
  869. PROCEDURE Reporter6
  870.  
  871.    @ 7,18 SAY "Are you sure you want to Quit? " 
  872.    yes_quit = Prompt()
  873.    Rid(7,18, "Are you sure you want to Quit?     " )
  874.  
  875. ********************
  876.  
  877. PROCEDURE List_ndx 
  878.  
  879.    PARAMETER f_o
  880.  
  881.    the_area = in_files[f_o]
  882.    SELECT &the_area
  883.    sst_ndx = ""
  884.    rpt22 = 1
  885.    _sstcount = 0
  886.    FOR qaz = 1 TO 10
  887.       DECLARE ndxfiles[10]
  888.       AFILL(ndxfiles, "")
  889.       SET ORDER TO qaz
  890.       IF !EMPTY(INDEXKEY(qaz))
  891.          ndxfiles[qaz] = IF(LEN(INDEXKEY(qaz)) > 20, SUBSTR(INDEXKEY(qaz), 1, 20), INDEXKEY(qaz))
  892.          _sstcount = _sstcount + 1
  893.       ENDIF
  894.    NEXT
  895.    IF EMPTY(INDEXORD())
  896.       RETURN
  897.    ENDIF
  898.    Wpush(4+f_o, 4, (_sstcount + 2 + 4+f_o), 36)
  899.    rpt22 = 1
  900.    DO WHILE .T.
  901.       Rpt_stat()
  902.       Reset()
  903.       Withquit(.T.)
  904.       rpt22 = Makemenu(ndxfiles, 5+f_o, 5, rpt22, 1,.T.,1,20,27)
  905.       Withquit(.F.)
  906.       IF rpt22 = 0
  907.          KEYBOARD CHR(27)
  908.          EXIT
  909.       ENDIF
  910.       Reset(.T.)
  911.       SET ORDER TO rpt22
  912.       sst_spec =  INDEXORD(rpt22)
  913.       sst_t_ndx = INDEXKEY(sst_spec)
  914.    ENDDO
  915.    Wpop()
  916.  
  917. ********************
  918.  
  919. PROCEDURE Rpt_stat
  920.  
  921.    STORE TIME() TO ssttime
  922.    @ 24,00 SAY ""
  923.    _oldcolor = SETCOLOR()
  924.    SETCOLOR(Reverse())
  925.    @ 24,00 CLEAR
  926.    IF !EMPTY(sst_t_file)
  927.       @ 24,00 SAY " USING " + Upperlower(sst_t_file)
  928.       IF TYPE("rpt15") != "U"
  929.          IF ALIAS() != sst_t_file .AND. rpt15 = 2
  930.             RETURN
  931.          ENDIF
  932.       ENDIF          
  933.       SELECT &sst_t_file.
  934.    ENDIF
  935.    IF EMPTY(sst_t_ndx)
  936.       @ 24,LEN(sst_t_file) + 7 CLEAR
  937.    ELSE
  938.       @ 24,LEN(sst_t_file) + 7 SAY " in " + LOWER(sst_t_ndx) + " Order "
  939.       SET ORDER TO sst_spec
  940.    ENDIF
  941.    IF !EMPTY(sstgroup)
  942.       @ 24,50 SAY "Grouped on &sstgroup."
  943.    ELSE
  944.       @ 24,50 CLEAR
  945.    ENDIF
  946.  
  947.    SETCOLOR(_oldcolor)
  948.  
  949. ********************
  950.  
  951. FUNCTION Dates_in
  952.  
  953.    pass_back = ""
  954.    Wpush( 5+rpt22, 6, 18+rpt22, 28 )
  955.    rpt221 = Makemenu("Year/What Month/Char to Date/Date to Char/Date to String/System Date/System Time/Day of Week/What Day of Week /System Seconds/Month of Year/Quit",Wrow(1), Wcol(1),rpt221,1,.T.)
  956.    Wpop()
  957.    IF     rpt221 = 1
  958.       RETURN(" YEAR("  + Fields_in(3,5,30) + ")")
  959.    ELSEIF rpt221 = 2
  960.       RETURN(" MONTH(" + Fields_in(3,5,30) + ")")
  961.    ELSEIF rpt221 = 3
  962.       RETURN(" CTOD("  + Fields_in(1,5,30) + ")")
  963.    ELSEIF rpt221 = 4
  964.       RETURN(" DTOC("  + Fields_in(3,5,30) + ")")
  965.    ELSEIF rpt221 = 5
  966.       RETURN(" DTOS("  + Fields_in(3,5,30) + ")")
  967.    ELSEIF rpt221 = 6
  968.       RETURN(" DATE() ")
  969.    ELSEIF rpt221 = 7
  970.       RETURN(" TIME() ")
  971.    ELSEIF rpt221 = 8
  972.       RETURN(" DOW(" + Fields_in(3,5,30) + ")")
  973.    ELSEIF rpt221 = 9
  974.       RETURN(" DAY(" + Fields_in(3,5,30) + ")")
  975.    ELSEIF rpt221 = 10
  976.       RETURN(" SECONDS() ")
  977.    ELSEIF rpt221 = 11
  978.       RETURN(" CMONTH(" + Fields_in(3,5,30) + ")")
  979.    ELSE
  980.       RETURN("")
  981.    ENDIF
  982.  
  983. ********************
  984.  
  985. FUNCTION Number_in
  986.  
  987.    Wpush(5+rpt22,6,14+rpt22,28)
  988.    rpt221 = Makemenu("Number to String /Absolute Value/Exponential/Logarithm/Remainder of/Square Root/Round Off/Quit",Wrow(1),Wcol(1),rpt221)
  989.    Wpop()
  990.    IF    rpt221 = 1
  991.       RETURN(" STR(" + Fields_in(2,5,30) + ")")
  992.    ELSEIF rpt221 = 2
  993.       RETURN(" ABS(" + Fields_in(2,5,30) + ")")
  994.    ELSEIF rpt221 = 3
  995.       RETURN(" EXP(" + Fields_in(2,5,30) + ")")
  996.    ELSEIF rpt221 = 4
  997.       RETURN(" LOG(" + Fields_in(2,5,30) + ")")
  998.    ELSEIF rpt221 = 5
  999.       RETURN(" MOD(" + Fields_in(2,5,35) + "," + Fields_in(2,6,30) + ")")
  1000.    ELSEIF rpt221 = 6
  1001.       RETURN(" SQRT(" + Fields_in(2,5,30) + ")")
  1002.    ELSEIF rpt221 = 7
  1003.       RETURN(" ROUND(" + Fields_in(2,5,30) + ")")
  1004.    ELSE
  1005.       RETURN("")
  1006.    ENDIF
  1007.  
  1008. ********************
  1009.  
  1010. FUNCTION String_in
  1011.  
  1012.    pass_back = ""
  1013.    Wpush( 5+rpt22,6,13+rpt22,50)
  1014.    rpt221 = Makemenu("ASCII Value/CHR Value/Value of/Transform to/Portion of String/Trim/Left Trim/All Trim/Expand String/All Upper Case/Proper Name/All Lower Case/Quit",Wrow(1),Wcol(1),rpt221,1,.T.,1,Wrow()+6)
  1015.    Wpop()
  1016.    DO CASE
  1017.    CASE rpt221 = 1
  1018.       pass_back = " ASC("
  1019.    CASE rpt221 = 2
  1020.       pass_back = " CHR("
  1021.    CASE rpt221 = 3
  1022.       pass_back = " STR(VAL(" + FIELDS_IN(2,5,50) + "))"
  1023.    CASE rpt221 = 4
  1024.       pass_back = ' TRANSFORM(' + FIELDS_IN(1,5,50)+ ', "@X") '
  1025.    CASE rpt221 = 5
  1026.       t_h_one = FIELDS_IN(1,5,50)
  1027.    CASE rpt221 = 6
  1028.       pass_back = " TRIM(" + FIELDS_IN(1,5,50) + ")"
  1029.    CASE rpt221 = 7
  1030.       pass_back = " LTRIM(" + FIELDS_IN(1,5,50) + ")"
  1031.    CASE rpt221 = 8
  1032.       pass_back = " LTRIM(TRIM(" + FIELDS_IN(1,5,50) + "))"
  1033.    CASE rpt221 = 9
  1034.       pass_back = " EXPAND(" + FIELDS_IN(1,5,50) + ")"
  1035.    CASE rpt221 = 10
  1036.       pass_back = " UPPER(" + FIELDS_IN(1,5,50) + ")"
  1037.    CASE rpt221 = 11
  1038.       pass_back = " UPPERLOWER(" + FIELDS_IN(1,5,50) + ")"
  1039.    CASE rpt221 = 12
  1040.       pass_back = " LOWER(" + FIELDS_IN(1,5,50)
  1041.    ENDCASE
  1042.    IF LASTKEY() = 27
  1043.       pass_back = ""
  1044.    ENDIF
  1045.    RETURN(pass_back)
  1046.  
  1047. ********************
  1048.  
  1049. FUNCTION Junct_in
  1050.  
  1051.    Wpush(5+rpt22,6,12+rpt22,17)
  1052.    rpt221 = Makemenu("And   /Not   /Or    /True  /False /Quit",Wrow(1),Wcol(1),rpt221)
  1053.    Wpop()
  1054.    IF     rpt221 = 1
  1055.       RETURN(" .AND. ")
  1056.    ELSEIF rpt221 = 2
  1057.       RETURN(" .NOT. ")
  1058.    ELSEIF rpt221 = 3
  1059.       RETURN(" .OR. ")
  1060.    ELSEIF rpt221 = 4
  1061.       RETURN(" .T. ")
  1062.    ELSEIF rpt221 = 5
  1063.       RETURN(" .F. ")
  1064.    ELSE
  1065.       RETURN("")
  1066.    ENDIF
  1067.  
  1068. ********************
  1069.  
  1070. FUNCTION Dbase_in
  1071.  
  1072.    Wpush(5+rpt22,6,14+rpt22,29)
  1073.    rpt221 = Makemenu("Relate Files/Last Record Number/Empty Expression /Beginning of File/End of File/Last Record Number/Deleted Record/Quit",Wrow(1),Wcol(1),rpt221)
  1074.    Wpop()
  1075.    IF rpt221 = 1
  1076.       RETURN(" RELATE(" + TIE_TOGET() + ")")
  1077.    ELSEIF rpt221 = 2
  1078.       RETURN(" LASTREC() ")
  1079.    ELSEIF rpt221 = 3
  1080.       RETURN(" EMPTY( " + FIELDS_IN(0,5,50) + ")")
  1081.    ELSEIF rpt221 = 4
  1082.       RETURN(" BOF() ")
  1083.    ELSEIF rpt221 = 5
  1084.       RETURN(" EOF() ")
  1085.    ELSEIF rpt221 = 6
  1086.       RETURN(" RECNO() ")
  1087.    ELSEIF rpt221 = 7
  1088.       RETURN(" DELETED() ")
  1089.    ELSE
  1090.       RETURN("")
  1091.    ENDIF
  1092.  
  1093. ********************
  1094.  
  1095. FUNCTION Operat_in
  1096.  
  1097.    Wpush( Wrow(8),8,Wrow(8)+8,68)
  1098.    rpt221 = Makemenu("Plus/Minus/Greater Than/Less Than/Greater Than or Equal Too/Less Than or Equal Too/Not Equal/Equal To/Multiply/Divide/Exponential/Quit",Wrow(1),Wcol(1),rpt221,3,.T.,1,Wrow(6))
  1099.    Wpop()
  1100.    IF      rpt221 = 1
  1101.       RETURN(" + ")
  1102.    ELSEIF rpt221 = 2
  1103.       RETURN(" - ")
  1104.    ELSEIF rpt221 = 3
  1105.       RETURN(" > ")
  1106.    ELSEIF rpt221 = 4
  1107.       RETURN(" < ")
  1108.    ELSEIF rpt221 = 5
  1109.       RETURN(" >= ")
  1110.    ELSEIF rpt221 = 6
  1111.       RETURN(" <= ")
  1112.    ELSEIF rpt221 = 7
  1113.       RETURN(" <> ")
  1114.    ELSEIF rpt221 = 8
  1115.       RETURN(" = ")
  1116.    ELSEIF rpt221 = 9
  1117.       RETURN(" * ")
  1118.    ELSEIF rpt221 = 10
  1119.       RETURN(" / ")
  1120.    ELSEIF rpt221 = 11
  1121.       RETURN(" ** ")
  1122.    ELSE
  1123.       RETURN("")
  1124.    ENDIF
  1125.  
  1126. ********************
  1127.  
  1128. PROCEDURE Special
  1129.  
  1130.    PARAMETERS p, l, v
  1131.  
  1132.    SET KEY 9 TO
  1133.    SET KEY 271 TO
  1134.    IF TYPE(v) = "U"
  1135.       overto = 0
  1136.    ELSE
  1137.       overto = LEN(TRIM(&v.))
  1138.    ENDIF
  1139.    t_tog_mag = 1
  1140.    Pushscreen(2,10,15,50,.T.,.F.,.F.)
  1141.    t_tog_mag = APOP(4, 20, 10, LENGTH_EL(macplus)+8, macplus)
  1142.  
  1143.    infront = IF(!READINSERT(), "", CHR(22))
  1144.    DO CASE
  1145.    CASE t_tog_mag = 0
  1146.    CASE t_tog_mag = 1
  1147.       KEYBOARD infront + REPLICATE(CHR(205), 130) + CHR(1)
  1148.    CASE t_tog_mag = 2
  1149.       KEYBOARD infront + REPLICATE(CHR(196), 130) + CHR(1)
  1150.    CASE t_tog_mag = 3
  1151.       KEYBOARD infront + REPLICATE(CHR(4), overto) + CHR(174)
  1152.    CASE t_tog_mag = 4
  1153.       KEYBOARD infront + REPLICATE(CHR(4), overto) + CHR(175)
  1154.    CASE t_tog_mag = 5
  1155.       KEYBOARD infront + REPLICATE("-", 130) + CHR(1)
  1156.    CASE t_tog_mag = 6
  1157.       KEYBOARD infront + REPLICATE(CHR(4), overto) + CHR(174) + "sstpage" + CHR(175)
  1158.    CASE t_tog_mag = 7
  1159.       KEYBOARD infront + REPLICATE(CHR(4), overto) + CHR(174) + "sstdate" + CHR(175)
  1160.    CASE t_tog_mag = 8
  1161.       KEYBOARD infront + REPLICATE(CHR(4), overto) + CHR(174) + "ssttime" + CHR(175)
  1162.    OTHERWISE
  1163.       KEYBOARD infront + REPLICATE(CHR(4), LEN(TRIM(&v.))) + CHR(174) + macplus[t_tog_mag] + CHR(175)
  1164.    ENDCASE                      
  1165.    Popscreen(2,10,15,50)
  1166.    SET KEY 9 TO Special
  1167.    SET KEY 271 TO Show_file
  1168.  
  1169. ********************
  1170.  
  1171. PROCEDURE Show_file
  1172.  
  1173.    PARAMETERS p, l, v
  1174.  
  1175.    * To really 'INSERT' the stuff, a drop marker should be placed into the field
  1176.    * BEFORE this procedure is called.  That way, the 'overto' variable will contain
  1177.    * the right number of characters to shove the new stuff to (with one extra
  1178.    * character of course.   If not, then the new field will be added to the end
  1179.    * of the current string, not at a specific marker.
  1180.  
  1181.    SET KEY 271 TO
  1182.    SET KEY 9 TO
  1183.    IF TYPE(v) != "C"
  1184.       overto = 0
  1185.    ELSE
  1186.       overto = LEN(TRIM(&v))   && Calculate the number of characters already in string
  1187.    ENDIF
  1188.  
  1189.    IF !EMPTY(sst_t_file)
  1190.       return_to = sst_t_file
  1191.       this_way = 1
  1192.       Wpush(1, 50, Occurence("/", sst_f_str)+3, 66)
  1193.       Withquit(.T.)
  1194.       this_way = Makemenu(sst_f_str, Wrow(1),Wcol(1),this_way, 1,.T.,1,12,11)
  1195.       Withquit(.F.)
  1196.       IF !EMPTY(this_way)
  1197.          goto_file = in_files[this_way]
  1198.          SELECT &goto_file
  1199.          prefix = CHR(16) + ALIAS() + "->" + FIELDS_IN(0, 2+this_way, 53) + CHR(17)
  1200.          infront = IF(!READINSERT(), "", CHR(22))
  1201.          IF LASTKEY() != 27
  1202.             KEYBOARD infront + REPLICATE(CHR(4), overto) + CHR(174) + prefix + CHR(175)
  1203.          ENDIF
  1204.       ENDIF
  1205.       SELECT &return_to
  1206.       Wpop()
  1207.    ENDIF
  1208.    SET KEY 9 TO Special
  1209.    SET KEY 271 TO Show_file
  1210.  
  1211. *******************
  1212.  
  1213. FUNCTION Tie_toget
  1214.  
  1215.    retuned = ALIAS()
  1216.    @ 20, 55 SAY "First, Pick the Field to"
  1217.    @ 21, 55 SAY "   tie everything to."
  1218.    field_first = FIELDS_IN(0,5,35)
  1219.    IF LASTKEY() = 27
  1220.       SCROLL(20,55,21,79,0)
  1221.       RETURN("")
  1222.    ENDIF
  1223.    all_others = sst_f_str
  1224.    back_area = ""
  1225.    SCROLL(20,55,21,79,0)
  1226.    DO WHILE .T.
  1227.       all_others = STRTRAN(all_others, "/" + ALIAS())
  1228.       IF LEN(all_others) < 2
  1229.          EXIT
  1230.       ENDIF
  1231.       this_way = 1
  1232.       @ 20,55 SAY "Now Choose the Files to"
  1233.       @ 21,55 SAY "   tie the field to."
  1234.       Wpush(4,35, Occurence("/", all_others)+6, 51)
  1235.       this_way = MAKEMENU(all_others,Wrow(1),Wcol(1),1, 1,.T.,1,12,11)
  1236.       Wpop()
  1237.       @ 20,55 SAY "                       "
  1238.       @ 21,55 SAY "                       "
  1239.       IF EMPTY(this_way)
  1240.          EXIT
  1241.       ENDIF
  1242.  
  1243.       parse_it = SUBSTR(Occur_at("/", all_others, this_way - 1), 2)
  1244.       IF EMPTY(AT("/", parse_it))
  1245.          goto_file = parse_it
  1246.       ELSE
  1247.          goto_file = SUBSTR(parse_it, 1, AT("/", parse_it) -1)
  1248.       ENDIF
  1249.  
  1250.       IF EMPTY(goto_file)
  1251.          SCROLL(20,55,21,79,0)
  1252.          @ 20,53 SAY "That File does NOT contain"
  1253.          @ 21,53 SAY "the selected field.  KEY.."
  1254.          INKEY(0)
  1255.          SCROLL(20,53,21,79,0)
  1256.       ELSE
  1257.          SELECT &goto_file.
  1258.          back_area = back_area + CHR(64 + SELECT()) +"/"
  1259.       ENDIF
  1260.    ENDDO
  1261.    SELECT &retuned.
  1262.    back_area = back_area + "Z"
  1263.    get_it_bck = back_area + '", "' + field_first
  1264.    RETURN('"' + get_it_bck + '"')
  1265.  
  1266. *********************
  1267.  
  1268. PROCEDURE Reset
  1269.  
  1270.    PARAMETERS _off
  1271.  
  1272.    IF PCOUNT() = 0
  1273.       SET KEY 18 TO Homeit
  1274.       SET KEY  3 TO Endit
  1275.    ELSE
  1276.       SET KEY 18 TO
  1277.       SET KEY 3 TO
  1278.    ENDIF
  1279.  
  1280. ********************
  1281.  
  1282. PROCEDURE Homeit
  1283.  
  1284.    KEYBOARD CHR(1)
  1285.  
  1286. ********************
  1287.  
  1288. PROCEDURE Endit
  1289.  
  1290.    KEYBOARD CHR(6)
  1291.  
  1292. ********************
  1293.  
  1294. PROCEDURE Withquit
  1295.  
  1296.    PARAMETERS _with
  1297.  
  1298.    IF _with
  1299.       SET KEY ASC("Q") TO _Force
  1300.       SET KEY ASC("q") TO _Force
  1301.    ELSE
  1302.       SET KEY ASC("Q") TO 
  1303.       SET KEY ASC("q") TO 
  1304.    ENDIF
  1305.  
  1306. *********************
  1307.  
  1308. PROCEDURE _force
  1309.  
  1310.    KEYBOARD CHR(27)
  1311.  
  1312. * End of File
  1313.