!*******************************************************************************
!  Program:     EDITCHK.SQR
!*******************************************************************************
!
!  Programmer:  David L Price (Ideatec, Inc.)
!               www.ideatec.us
!  Email:       david@ideatec.us
!  Phone:       (510) 853-4070
!
!*******************************************************************************
!
!  This program is the original work of David L. Price of Ideatec, Inc.
!  All Rights Reserved.
!
!  The latest version of the program can be found at:
!  http://www.ideatec.us/software.htm
!
!*******************************************************************************
!
!  This program verifies to the best of its ability that the data in
!  those fields which have some type of Table Edit (Y/N, Xlat, or
!  Prompt Table) are valid values, based on the edit table.  Some
!  Prompt Table edits rely on key values being present on the panel,
!  but not necessarily on the current record.  Since data necessary to
!  perform the check is not available, this program is unable to
!  determine the validity of the underlying data and will display a
!  message stating so.  Other Prompt Table edits rely on dynamically
!  defined Prompt Tables (such as %EDITTABLE).  This program is unable
!  to perform checks in this situation either and will display an
!  error message stating that the Prompt Table is invalid.  Y/N and
!  Xlat checks should work correctly in all situations.
!
!  DEBUG OPTIONS    A = show procedure names
!                   B = show progress as records are being processed
!
!*******************************************************************************
!                   Known Issues
!
! 03/25/97  When a record has the field EFFDT with a Prompt Table edit,
!           program returns an ORA-01858 select error. (see ASGN_CMP_HOMHST)
!
!*******************************************************************************
!                   SQR Modification Log
!
!    DATE      VERSION   DESCRIPTION
! ==========   =======   ===================================================
! 02-14-1997   1.0       Created for PeopleSoft 5 using ORACLE.
!
! 02-25-1997   2.0       Major modifications to the way Prompt Tables are
!                        checked.
!
! 03-24-1997   2.1       Add ability to validate fields when only edit is
!                        REQUIRED.
!
! 11-14-1997   3.0       Removed dependencies on #includes.  Removed Process
!                        Scheduler logic.  Modified user interface.
!
! 07-20-1998   3.1       Added missing LANGUAGE_REPORT define.  Validated
!                        on PeopleSoft 7.0 using ORACLE.
!
! 04-26-1999   3.2       Added support for the Informix database.
!
! 03-01-2001   4.0       Modified ORACLE NLS_DATE to show four digit year.
!                        Fixed Analyze-Edit-Table SQL (added order by).
!                        Tested using PeopleTools 8.12 on ORACLE.
!                        Added additional processing to handle SETIDs
!                        (specifically when fields such as SETID_DEPT are
!                        used instead of SETID).  Improved user interface --
!                        provided more options for input.
!
! 11-16-2001   4.01      Updated contact information.  Changed Rights of Use.
!
! 12-04-2002   4.1   (1) Removed effective date checking on Prompt Tables
!                        when the source record does not contain an effective
!                        date.  There was no way of knowing if the value was
!                        active when originally inserted into the source table.
!                        This was causing problems for Payroll balance tables
!                        that uses Pay-End-Date instead of EffDate.  Alternative
!                        is to check for PAY_END_DT much like EFFDT.... or
!                        maybe any date field in the keys.
!
!                    (2) Added the ability to also specify a fieldname. The
!                        program will expect RECNAME.FIELDNAME.  Neither the
!                        RECNAME or the FIELDNAME is required.  For example:
!                          COMPANY_TBL.DESCR - Checks only the DESCR field
!                                              in the COMPANY_TBL table
!                          .COMPANY          - Checks every occurrence of
!                                              COMPANY in the database
!                          JOB               - Checks all fields on JOB
!                          CO%.DE%           - Checks all the fields which
!                                              start with "DE" in any table
!                                              which start with "CO"
!
!                        "@" still can only process records (not fields) from
!                        a flat file.
!
!                    (3) Added option to allow user to suppress certain error
!                        messages such as "Unable to check long fields" or
!                        "Invalid Prompt Table".  This option is toggled by
!                        entering "/S" at the prompt.
!
!                    (4) Modified to return to input prompt (instead of ending
!                        program) after checking tables.  User must now enter
!                        a blank input prompt to exit program.
!
!*******************************************************************************

#define TRUE     1
#define FALSE    0
#define VERSION  4.1

#define ColR     108
#define LANGUAGE_REPORT 'ENG'

!*******************************************************************************
begin-setup
!*******************************************************************************

printer-init <27>E<27>(0N<27>&l0O<27>&l8D<27>&l88F<27>(s16.66H<27>&a9L
page-size 79 125

end-setup

!*******************************************************************************
begin-report
!*******************************************************************************

move 'EDITCHK'                 to $ReportID
move 'PeopleSoft Edit Checker' to $ReportTitle
do Init-Report
while {TRUE}
   let $OldRecName      = 'FIRST'

   do Prompt-User
   do Report
   show ' '
   show ' '
end-while

end-report

!*******************************************************************************
begin-procedure Init-Report
!*******************************************************************************

show '------------------------------------------------------------------------'
show $ReportTitle
show 'Version {VERSION}'
show 'by David L. Price (david@ideatec.us)'
show '------------------------------------------------------------------------'
show ' '
show 'This program verifies to the best of its ability that the data in'
show 'those fields which have some type of Table Edit (Y/N, Xlat, or'
show 'Prompt Table) are valid values, based on the edit table.  Some'
show 'Prompt Table edits rely on key values being present on the panel,'
show 'but not necessarily on the current record.  Since data necessary to'
show 'perform the check is not available, this program is unable to'
show 'determine the validity of the underlying data and will display a'
show 'message stating so.  Other Prompt Table edits rely on dynamically'
show 'defined Prompt Tables (such as %EDITTABLE).  This program is unable'
show 'to perform checks in this situation either and will display an'
show 'error message stating that the Prompt Table is invalid.  Y/N and'
show 'Xlat checks should work correctly in all situations.'
show ' '
show 'PeopleTools 5.x, 7.0, 8.12'
show 'Informix; Oracle 7, 8'
show 'SQR 3, 4, 6'
show ' '

date-time () MM/DD/YYYY  &ReportDate
date-time () HH:MI       &ReportTime

! Global Variables
let #NeedNewPage     = {FALSE}
let #Suppress_Errors = {FALSE}

evaluate $sqr-database
   when = 'ORACLE'
      let $Today = 'SYSDATE'
      begin-sql
      ALTER SESSION SET NLS_DATE_FORMAT='DD-MON-YYYY';
      ALTER SESSION SET NLS_DATE_LANGUAGE='AMERICAN';
      end-sql
      break
   when = 'INFORMIX'
      let $Today = 'TODAY'
      break
   when-other
      show ' '
      show '= = = = = = = = = E R R O R = = = = = = = = ='
      show ' '
      show 'Sorry.  PeopleSoft Edit Checker currently    '
      show 'only works on Oracle and Informix databases. '
      show ' '
      show '= = = = = = = = = = = = = = = = = = = = = = ='
      stop quiet
end-evaluate

create-array name=Key size=10
  field=Fld:char

end-procedure

!*******************************************************************************
begin-heading 5
!*******************************************************************************

print '          '      (1,1)        center

print 'Report ID:  '    (+1,1)
print $ReportID         ()
uppercase $ReportTitle
print $ReportTitle      ()           center
let #RptCol = {ColR} - 2
page-number             (0,#RptCol)  'Page No.  '

print 'Run Date '       (+1,#RptCol)
print &ReportDate       ()

print 'Run Time '       (+1,#RptCol)
print &ReportTime       ()
print 'Record:'         (3,1)
print $RecName          (0,13)
if not isblank($FieldMask)
   print '.' ()
   print $FieldMask ()
end-if
print 'Key:'            (4,1)
print $KeyFields        (0,13)

print 'Key'             (+2,1)
print 'Value'           (0,90)

end-heading

!*******************************************************************************
begin-procedure Report
!*******************************************************************************
#DEBUGA show 'REPORT'

begin-select
X.RECNAME       () on-break print=never after=Change-Record
X.FIELDNAME
X.EDITTABLE
X.USEEDIT
Z.FIELDTYPE

   move &X.RECNAME   to $RecName
   move &X.FIELDNAME to $FieldName
   if $sqr-database = 'INFORMIX'
      let $FieldName = translate($FieldName,'#','N')
   end-if
   move &X.EDITTABLE to $EditTable
   move &X.USEEDIT   to #UseEdit
   move &Z.FIELDTYPE to #FieldType

   do Determine-Edit-Type

   evaluate $EditType
      when = 'R'
         if $RecName <> $OldRecName
            do Determine-Key
            Move $RecName to $OldRecName
         end-if
         do Check-For-Required
         break
      when = 'Y'
         if $RecName <> $OldRecName
            do Determine-Key
            Move $RecName to $OldRecName
         end-if
         do Check-For-YN
         break
      when = 'X'
         if $RecName <> $OldRecName
            do Determine-Key
            Move $RecName to $OldRecName
         end-if
         do Check-For-Xlat
         break
      when = 'P'
         if $RecName <> $OldRecName
            do Determine-Key
            Move $RecName to $OldRecName
         end-if
         do Check-For-Prompt
         break
   end-evaluate

from PSRECFIELD X,
     PSRECDEFN  Y,
     PSDBFIELD  Z
where X.RECNAME   = Y.RECNAME
and   Z.FIELDNAME = X.FIELDNAME
and   Y.RECTYPE   = 0
[$WhereClause]
order by X.RECNAME, X.FIELDNAME
end-SELECT

END-PROCEDURE

!*******************************************************************************
begin-procedure Check-For-Required
!*******************************************************************************
#DEBUGA show '  CHECK-FOR-REQUIRED'
#DEBUGB show '.' NOLINE

do Set-Fieldtype-Specifics
let #Print_Count = 0

let $SRecName   = '''' || $RecName || ''''
let $SFieldName = '''' || $FieldName || ''''
let $SQL-Statement = 'EDITCHK.SQR,CHECK-FOR-REQUIRED,Select'
begin-select on-error=Select-Error Loops=100
[$SRecName]         &ra=char
[$SFieldName]       &rb=char     () on-break print=never before=Change-Field
[$KeyValue]         &rc=char           (+1,1,89)
[$PromptField]      &rFieldValue=char  (0,90,30)

   let #NeedNewPage = {TRUE}
   add 1 to #Print_Count

from PS_[$RecName]
where [$FieldName] [$PSNull]
end-select

if #Print_Count = 100
   print '***** NOTE: Only first one hundred errors printed *****' (+1,1)
end-if

end-procedure

!*******************************************************************************
begin-procedure Check-For-YN
!*******************************************************************************
#DEBUGA show '  CHECK-FOR-YN'
#DEBUGB show '.' NOLINE

let #Print_Count = 0
if $Required = 'N'
   let $Clause = ','' '''
else
   let $Clause = ''
end-if

let $SRecName   = '''' || $RecName || ''''
let $SFieldName = '''' || $FieldName || ''''
let $SQL-Statement = 'EDITCHK.SQR,CHECK-FOR-YN,Select'
begin-select on-error=Select-Error Loops=100
[$SRecName]         &ya=char
[$SFieldName]       &yb=char     () on-break print=never before=Change-Field
[$KeyValue]         &yc=char           (+1,1,89)
[$FieldName]        &yFieldValue=char  (0,90,30)

   let #NeedNewPage = {TRUE}
   add 1 to #Print_Count

from PS_[$RecName]
where not [$FieldName] in ('Y','N' [$Clause])
end-select

if #Print_Count = 100
   print '***** NOTE: Only first one hundred errors printed *****' (+1,1)
end-if

end-procedure

!*******************************************************************************
begin-procedure Check-For-Xlat
!*******************************************************************************
#DEBUGA show '  CHECK-FOR-XLAT'
#DEBUGB show '.'  NOLINE

let #Print_Count = 0
if $Required = 'N'
   let $Clause = 'or ' || $FieldName || ' = '' '''
else
   let $Clause = ''
end-if

if not isblank($DateCheck)
   let $Wh = 'and B.EFFDT = (select max(B1.EFFDT) from XLATTABLE B1 '
   let $Wh = $Wh || 'where B1.FIELDNAME = B.FIELDNAME and B1.LANGUAGE_CD = B.LANGUAGE_CD '
   let $Wh = $Wh || 'and B1.FIELDVALUE  = B.FIELDVALUE and B1.EFFDT <= ' || $DateCheck || ')'
else
   let $Wh = ''
end-if

let $SRecName   = '''' || $RecName || ''''
let $SFieldName = '''' || $FieldName || ''''
let $SQL-Statement = 'EDITCHK.SQR,CHECK-FOR-XLAT,Select'
begin-select on-error=Select-Error Loops=100
[$SRecName]         &xa=char
[$SFieldName]       &xb=char     () on-break print=never before=Change-Field
[$KeyValue]         &xc=char           (+1,1,89)
[$FieldName]        &xFieldValue=char  (0,90,30)

   let #NeedNewPage = {TRUE}
   add 1 to #Print_Count

from PS_[$RecName]
where not ( exists (select 'x'
                  from XLATTABLE B
                  where B.FIELDNAME   = $FieldName
                  and   B.LANGUAGE_CD = {LANGUAGE_REPORT}
                  and   B.FIELDVALUE  = [$FieldName]
                  and   B.EFF_STATUS  = 'A'
                  [$Wh] )
[$Clause] )
end-SELECT

if #Print_Count = 100
   print '***** NOTE: Only first one hundred errors printed *****' (+1,1)
end-if

end-procedure

!*******************************************************************************
begin-procedure Check-For-Prompt
!*******************************************************************************
#DEBUGA show '  CHECK-FOR-PROMPT'
#DEBUGB show '.' NOLINE

do Set-Fieldtype-Specifics
let #Print_Count = 0

! Add null exception if 'Not Required'
if $Required = 'N'
   let $Clause = 'or ' || $FieldName || $PSNull
else
   let $Clause = ''
end-if

do Analyze-Edit-Table

let $SRecName   = '''' || $RecName || ''''
let $SFieldName = '''' || $FieldName || ''''
let $SQL-Statement = 'EDITCHK.SQR,CHECK-FOR-PROMPT,Select'

! show '*******************************************'
! show 'SELECT'
! show $SRecName
! show $SFieldName
! show $KeyValue
! show $PromptField
! show 'from PS_' $RecName
! show 'where not (exists (select ''x'''
! show '                   from PS_' $EditTable ' c'
! show '                   where ' $Wh
! show '                  )'
! show $Clause ' )'
! show '*******************************************'

begin-select on-error=Select-Error loops=100
[$SRecName]         &pa=char
[$SFieldName]       &pb=char     () on-break print=never before=Change-Field
[$KeyValue]         &pc=char           (+1,1,89)
[$PromptField]      &pFieldValue=char  (0,90,30)

   let #NeedNewPage = {TRUE}
   add 1 to #Print_Count

from PS_[$RecName]
where not ( exists (select 'x'
                    from PS_[$EditTable] c
                    where [$Wh]
                  )
[$Clause] )
end-select


if #Print_Count = 100
   print '***** NOTE: Only first one hundred errors printed *****' (+1,1)
end-if

end-procedure

!*******************************************************************************
begin-procedure Analyze-Edit-Table
!*******************************************************************************
! Builds main part of Where clause.  The procedure will first put all
! of the key fields in an array so that it may look forward and back
! in the key list (something it couldn't do if you did the processing
! in the Select).  It then analyzes each field and builds the query
! based on what it finds.
#DEBUGA show '    ANALYZE-EDIT-TABLE'

let $Status-Check = ''

let #MaxPosn      = 0
let #LastKey      = 0
clear-array name=Key

let $SQL-Statement = 'EDITCHK.SQR,ANALYZE-EDIT-TABLE,Select'
begin-select
FIELDNAME   &KeyField
FIELDNUM    &KeyPosn

   move &KEYPOSN to #KeyPosn

   if #KeyPosn > #MaxPosn
      move #KeyPosn to #MaxPosn
   end-if

   if &KeyField <> 'EFFDT' and &KeyField <> 'EFFSEQ'
      let #LastKey = #KeyPosn
   end-if

   if $sqr-database = 'INFORMIX'
      let $tempField = translate(&KeyField,'#','N')
   else
      let $tempField = &KeyField
   end-if

   put $tempField into Key(#KeyPosn)

from PSRECFIELD
where RECNAME        =  $EditTable
and   mod(USEEDIT,2) <> 0
order by FIELDNUM
end-select

let $Wh        = ''

let #x = 1
while #x <= #MaxPosn

   let $Test = Key.Fld(#x)
   evaluate $Test
      when = 'SETID'
         if #HasSETID
            let $SETID_Field = 'SETID'
         else
            do Find-SETID-Field
         end-if
         let $Wh = $Wh || 'c.' || Key.Fld(#x) || ' = PS_' || $RecName || '.' || $SETID_Field || ' and '
         break
      when = 'EFFDT'
         if not isblank($DateCheck)
            let $Wh = $Wh || 'c.EFFDT = (select max(c1.effdt) from PS_'
            let $Wh = $Wh || $EditTable || ' c1 where '
            let #y = 1
            while #y <= (#x - 1)
               let $Wh = $Wh || 'c1.' || Key.Fld(#y) || ' = c.' || Key.Fld(#y) || ' and '
               add 1 to #y
            end-while
            let $Wh = $Wh || 'c1.effdt <= ' || $DateCheck || ' ) and '
         end-if
         break
      when = 'EFFSEQ'
         if not isblank($DateCheck)
            let $Wh = $Wh || 'c.EFFSEQ = (select max(c2.effseq) from PS_' || $EditTable
            let $Wh = $Wh || ' c2 where '
            let #y = 1
            while #y <= (#x - 1)
               let $Wh = $Wh || 'c2.' || Key.Fld(#y) || ' = c.' || Key.Fld(#y) || ' and '
               add 1 to #y
            end-while
         end-if
         break
      when-other
         if (#x = #LastKey)
            let $Wh = $Wh || 'c.' || Key.Fld(#x) || ' = PS_' || $RecName || '.' || $FieldName
         else
            let $Wh = $Wh || 'c.' || Key.Fld(#x) || ' = PS_' || $RecName || '.' || Key.Fld(#x)
         end-if
         let $Wh = $Wh || ' and '
         break
   end-evaluate

   add 1 to #x

end-while

! Trim off last ' and '
let $Wh = substr($Wh , 1 , length($Wh) - 5)

! Add logic to only grab Active rows if EFF_STATUS is present.
begin-select
FIELDNAME     &NextField

   if &NextField = 'EFF_STATUS'
      let $Wh = $Wh || ' and c.EFF_STATUS = ''A'''
   end-if

from PSRECFIELD
where RECNAME  = $EditTable
and   FIELDNUM = (#MaxPosn + 1)
end-select

end-procedure

!*******************************************************************************
begin-procedure Find-SETID-Field
!*******************************************************************************
! If at some point it is found that one field may have more than one possible
! alias (for example, if DEPTID uses SETID_DEPT in some places, and
! SETID_DEPTID in others), this code will have to be modified.  Currently
! only one alias per field is considered.

let $SETID_Field = 'SETID'
do Find-Field($RecName, 'SETID', #Found_Field)

if not #Found_Field
   ! Does it make sense to use the Fieldname here, or would it make more
   ! sense to use the Edit Table Name?  i.e., STEP vs. SAL_STEP_TBL

   ! Known Aliases.  Additional will be added as discovered.
   evaluate $Fieldname
   when = 'DEPTID' ! or
      let $SETID_Field = 'SETID_DEPT'
      break
   when = 'JOBCODE'
      let $SETID_Field = 'SETID_JOBCODE'
      break
   when = 'LOCATION'
      let $SETID_Field = 'SETID_LOCATION'
      break
   when = 'SAL_ADMIN_PLAN'
   when = 'GRADE'
   when = 'STEP'
   when = 'REVIEW_RATING'
   when = 'SALARY_MATRIX_CD'
      let $SETID_Field = 'SETID_SALARY'
      break
   end-evaluate
end-if

end-procedure

!*******************************************************************************
begin-procedure Find-Field($in_Record, $in_Field, :#FieldFound)
!*******************************************************************************
! This procedure will return #FieldFound as TRUE if the field $in_Field is
! found in the record $in_Record.

let #FieldFound = {FALSE}

begin-select
'X'

   let #FieldFound = {TRUE}

from PSRECFIELD
where RECNAME = $in_Record
and   FIELDNAME = $in_Field
end-select

end-procedure

!*******************************************************************************
begin-procedure Set-Fieldtype-Specifics
!*******************************************************************************

! PeopleSoft handles Nulls differently for different types.
evaluate #FieldType
   when = 0                              ! Char
      let $PSNull = ' = '' '''
      break
   when = 2                              ! Number
   when = 3                              ! Signed Number
      let $PSNull = ' = 0'
      break
   when = 4                              ! Date
   when = 5                              ! Time
   when = 6                              ! Date/Time
      let $PSNull = ' is NULL'
      break
end-evaluate

! Need to convert numerics and dates to character strings on Oracle databases
if #FieldType <> 0 and $sqr-database = 'ORACLE'
   let $PromptField = 'to_char(' || $FieldName || ')'
else
   let $PromptField = $FieldName
end-if

end-procedure

!*******************************************************************************
begin-procedure Change-Record
!*******************************************************************************
#DEBUGA show '    CHANGE-RECORD'

if #NeedNewPage
   new-page
   let #NeedNewPage = {FALSE}
end-if

end-procedure

!*******************************************************************************
begin-procedure Change-Field
!*******************************************************************************
#DEBUGA show '    CHANGE-FIELD'

next-listing need=5
print '='               (2,1,124) FILL
print 'Field:'          (+1,6)
print $FieldName        (0,14)
print 'Edit:'           (0,39)
evaluate $EditType
   when = 'Y'
      let $out = 'Y/N'
      break
   when = 'X'
      let $out = 'Translate Table'
      break
   when = 'P'
      let $out = 'Prompt Table (' || $EditTable || ')'
      break
   when = 'R'
      let $out = 'None'
      break
   when-other
      let $out = 'Unknown'
      break
end-evaluate
print $out               (0,45)

if $Required = 'Y'
   print 'REQUIRED'      (0,90)
end-if

print '='                (+1,1,124) FILL

let #First = {FALSE}

end-procedure

!*******************************************************************************
begin-procedure Select-Error
!*******************************************************************************
!  This receives all Select errors, interprets them, and translate them
!  in English back to user.

#DEBUGA show '    SELECT-ERROR'
#DEBUGA show '    ' $sql-statement
#DEBUGA show '    ' $sql-error
#DEBUGA show ' '


#DEBUGB show '*'  NOLINE

let #Suppressible = {FALSE}

let $Eval = substr($sql-error,1,9)
evaluate $Eval
   when = 'ORA-00904'
      let $ErrMsg = 'All necessary fields are not present to perform check'
      let #Suppressible = {TRUE}
      break
   when = 'ORA-00911'
   when = 'An illega'  ! An illegal character has been found in the statement
      let $ErrMsg = 'Invalid Prompt Table (Most likely a dynamic table reference)'
      let #Suppressible = {TRUE}
      break
   when = 'ORA-00936'
   when = 'A syntax '  ! A syntax error has occurred.
      let $ErrMsg = 'Prompt Table does not exist or has no keys defined'
      break
   when = 'Blobs are'  ! Blobs are not allowed in this expression.
      let $ErrMsg = 'Unable to check long fields'
      let #Suppressible = {TRUE}
      break
   when-other
      let $ErrMsg = rtrim($Sql-Error, chr(10))
      #DEBUGA show '---------------------------------------'
      #DEBUGA show 'select ' $PromptField
      #DEBUGA show 'from PS_' $RecName
      #DEBUGA show 'where not exists (select ''x'''
      #DEBUGA show '                   from PS_' $EditTable ' c'
      #DEBUGA show '                   where ' $Wh
      #DEBUGA show '                  )'
      #DEBUGA show $Clause ')'
      #DEBUGA show '---------------------------------------'
      break
end-evaluate

if #Suppressible and #Suppress_Errors
  ! Do Nothing
else
   do Change-Field
   let #NeedNewPage  = {TRUE}

   print '***** '    (+1,1)
   print $ErrMsg        (0,0)
   print ' *****'    (0,0)
end-if

end-procedure

!*******************************************************************************
begin-procedure Determine-Edit-Type
!*******************************************************************************
#DEBUGA show '  DETERMINE-EDIT-TYPE'

let $EditType = 'N'         ! N=None  P=Prompt  Y=Y/N  X=Xlat  R=Required Only
let $Required = 'N'         ! Y=Required  N=Not-Required

!Determine Prompts (if any)
if trunc( #UseEdit / 16384 , 0 ) - ( trunc( #UseEdit / 32768 , 0 ) * 2 ) <> 0
   ! Check for Prompt Table edit
   let $EditType = 'P'
else
   if trunc( #UseEdit / 8192 , 0 ) - ( trunc( #UseEdit / 16384 , 0 ) * 2 ) <> 0
      ! Check for Y/N edit
      let $EditType = 'Y'
   else
      if trunc( #UseEdit / 512 , 0 ) - ( trunc( #UseEdit / 1024 , 0 ) * 2 ) <> 0
         ! Check for XLAT edit
         let $EditType = 'X'
      end-if
   end-if
end-if

!Determine if Required
if trunc( #UseEdit / 256 , 0 ) - ( trunc( #UseEdit / 512 , 0 ) * 2 ) <> 0
   ! Check for Required flag
   let $Required = 'Y'
   if $EditType = 'N'
      let $EditType = 'R'
   end-if
end-if

end-procedure

!*******************************************************************************
begin-procedure Determine-Key
!*******************************************************************************
#DEBUGA show '  DETERMINE-KEY'

let $KeyFields   = ''
let $KeyValue    = ''
let $DateCheck   = ''
let #NewRecord   = {TRUE}
let #HasSETID    = {FALSE}

show ' '
show '  ' $RecName NOLINE

begin-select
B.KEYPOSN
B.FIELDNAME

   let $KeyFields = $KeyFields || &B.FIELDNAME || ', '
   let $KeyValue  = $KeyValue  || &B.FIELDNAME || ' || ' || ''' ''' || ' || '

   if &B.FIELDNAME = 'EFFDT'
      let $DateCheck = 'PS_' || $RecName || '.EFFDT'
   end-if

   if &B.FIELDNAME = 'SETID'
      let #HasSETID = {TRUE}
   end-if

from PSKEYDEFN B
where B.RECNAME = $RecName
and   B.INDEXID = '_'
order by B.KEYPOSN
end-select

let $KeyFields = rtrim($KeyFields,', ')
let $KeyValue  = rtrim($KeyValue,'| ')

if $sqr-database = 'INFORMIX'
   let $KeyFields = translate($KeyFields,'#','N')
   let $KeyValue  = translate($KeyValue,'#','N')
end-if

end-procedure

!*******************************************************************************
begin-procedure Prompt-User
!*******************************************************************************

The_Beginning:

let $WhereClause = ''
let $TableMask   = ''
let $FieldMask   = ''

input $InputMask 'Enter Search (''?'' for insturctions)'
if isblank($InputMask)
   show ' '
   show 'Ending Program.'
   stop quiet
end-if

uppercase $InputMask
let $TestChar = substr($InputMask,1,1)
evaluate $TestChar
when = '@'
   do Process-FileList
   if isblank($WhereClause)
      goto The_Beginning
   end-if
   break
when = '?'
   do Show-Instructions
   goto The_Beginning
   break
when = '/'
   ! Configuration Options
   let $InputMask = ltrim($InputMask, '/')
   evaluate $InputMask
   when = 'S'
      let #Suppress_Errors = not #Suppress_Errors
      show ' '
      if #Suppress_Errors
         show '  === Supressible errors supressed ==='
      else
         show '  === Supressible errors not suppressed ==='
      end-if
      show ' '
      break
   when-other
      show ' '
      show '  *** Unknown Option ***'
      show ' '
      break
   end-evaluate
   goto The_Beginning
   break
when-other
   unstring $InputMask by '.' into $TableMask $FieldMask
   let $TableMask = rtrim(ltrim($TableMask,' '),' ')
   let $FieldMask = rtrim(ltrim($FieldMask,' '),' ')

   ! Check if Table is specified
   if not isblank($TableMask) and $TableMask <> 'ALL'
      let $WhereClause = $WhereClause || 'and X.RECNAME like ''' || $TableMask || ''' '
   end-if

   ! Check if Field is specified
   if not isblank($FieldMask)
      let $WhereClause = $WhereClause || 'and X.FIELDNAME like ''' || $FieldMask || ''' '
   end-if
   break
end-evaluate

show ' '
show 'Processing....'

end-procedure

!*******************************************************************************
begin-procedure Show-Instructions
!*******************************************************************************

show ' '
show '================================================================================'
show 'INSTRUCTION: Searches can be entered in any one of the following ways:'
show ' '
show '(1) You can enter ''ALL'' to check every table in the database.  WARNING:  This '
show 'will take a considerable amount of time.  This is not recommended.'
show ' '
show '(2) You can type in the ''@'' character, followed by the filename of an ASCII'
show 'file containing a list of the tables to be checked.  This file should have one'
show 'table per line.  Wildcards and fieldnames are not allowed.'
show ' '
show '(3) Enter a record and/or field name using the RECNAME.FIELDNAME format.'
show 'Neither, the RECNAME or the FIELDNAME, are required.  For example:'
show '    JOB.EMPLID - Checks only the EMPLID field on PS_JOB.'
show '    .COMPANY   - Checks every occurance of the field COMPANY in the database.'
show '    JOB        - Checks all fields on the PS_JOB table.'
show '    CO%.DE%    - Checks all the fields which start with "DE" in any table which'
show '                 start with "CO".'
show ' '
show 'NOTE: The percent character (%) acts as a wild card.  Do not enter the ''PS_'''
show 'portion of the table name.'
show '================================================================================'
show ' '

end-procedure

!*******************************************************************************
begin-procedure Process-FileList
!*******************************************************************************

let $InputMask = ltrim($InputMask, '@')

open $InputMask as 1
   for-reading
   record=300
   status=#Open_Error

if #Open_Error
   show ' '
   show '  *** Unable to find filename ***'
   show ' '
   let $WhereClause = ''
else

   let $WhereClause = 'and X.RECNAME in ('

   read 1 into $InLine:300
   while not #end-file
      let $InLine = upper(rtrim(ltrim($InLine, ' '), ' '))
      if not isblank($InLine)
         let $WhereClause = $WhereClause || '''' || $InLine || ''','
      end-if
      read 1 into $InLine:3000
   end-while

   let $WhereClause = rtrim($WhereClause,',') || ')'
end-if

end-procedure
