rplctn/mkrecstr.p

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12
   2 &ANALYZE-RESUME
   3 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure
   4 /*--------------------------------------------------------------------------
   5     File        :  mkrecstr.p
   6     Purpose     :  Make a program to display a string description
   7                    of a particalar record
   8
   9     Syntax      :  mkrecstr.p
  10
  11     Description :
  12
  13     Author(s)   : Tyrone McAuley
  14     Created     : 10/10/97
  15     Notes       :
  16   ------------------------------------------------------------------------*/
  17 /*          This .W file was created with the Progress UIB.             */
  18 /*----------------------------------------------------------------------*/
  19
  20 /* ***************************  Definitions  ************************** */
  21
  22 DEF INPUT PARAMETER table-name AS CHAR NO-UNDO.
  23 DEF INPUT PARAMETER file-name  AS CHAR NO-UNDO.
  24
  25 /* _UIB-CODE-BLOCK-END */
  26 &ANALYZE-RESUME
  27
  28
  29 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  30
  31 /* ********************  Preprocessor Definitions  ******************** */
  32
  33 &Scoped-define PROCEDURE-TYPE Procedure
  34
  35
  36
  37 /* _UIB-PREPROCESSOR-BLOCK-END */
  38 &ANALYZE-RESUME
  39
  40
  41 /* ************************  Function Prototypes ********************** */
  42
  43 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD add-field-to-desc Procedure
  44 FUNCTION add-field-to-desc RETURNS CHARACTER
  45   ( INPUT-OUTPUT desc-clause AS CHAR )  FORWARD.
  46
  47 /* _UIB-CODE-BLOCK-END */
  48 &ANALYZE-RESUME
  49
  50
  51 /* *********************** Procedure Settings ************************ */
  52
  53 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  54 /* Settings for THIS-PROCEDURE
  55    Type: Procedure
  56    Allow:
  57    Frames: 0
  58    Add Fields to: Neither
  59    Other Settings: CODE-ONLY COMPILE
  60  */
  61 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  62
  63 /* *************************  Create Window  ************************** */
  64
  65 &ANALYZE-SUSPEND _CREATE-WINDOW
  66 /* DESIGN Window definition (used by the UIB)
  67   CREATE WINDOW Procedure ASSIGN
  68          HEIGHT             = .4
  69          WIDTH              = 37.72.
  70 /* END WINDOW DEFINITION */
  71                                                                         */
  72 &ANALYZE-RESUME
  73
  74
  75
  76
  77 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
  78
  79
  80 /* ***************************  Main Block  *************************** */
  81
  82 DEF VAR desc-clause AS CHAR NO-UNDO.
  83
  84     /* Create the where clause that constitues the unique find
  85        on the given table */
  86
  87     FIND FIRST _File WHERE _File._File-Name = table-name NO-LOCK NO-ERROR.
  88     FIND FIRST _Index WHERE
  89       _Index._File-recid = RECID( _File ) AND
  90       _Index._Unique
  91       NO-LOCK NO-ERROR.
  92
  93     IF NOT AVAILABLE _Index THEN DO:
  94       FIND _Index WHERE RECID(_Index) = _File._Prime-Index NO-LOCK NO-ERROR.
  95       /*
  96       MESSAGE   "Could not display the record    " SKIP
  97                 "because there is no unique index" SKIP
  98                 "for the table" '"' + _File._File-Name + '"!'
  99                 VIEW-AS ALERT-BOX ERROR TITLE "Replication Warning".
 100       RETURN "FAIL".
 101       */
 102     END.
 103
 104     /* Show key fields first */
 105     FOR EACH _Index-Field NO-LOCK WHERE
 106       _Index-Field._Index-RecID = RECID( _Index ),
 107       EACH _Field WHERE RECID( _field ) = _Index-Field._Field NO-LOCK:
 108       add-field-to-desc( desc-clause ).
 109     END.
 110
 111     /* Now the rest of the fields */
 112     FOR EACH _Field NO-LOCK
 113       WHERE _Field._File = RECID( _File )
 114         AND NOT CAN-FIND( _Index-Field WHERE _Index-Field._Index-RecID = RECID( _Index )
 115                                          AND _Index-Field._Field = RECID( _Field ) ):
 116       add-field-to-desc( desc-clause ).
 117     END.
 118
 119
 120     OUTPUT TO VALUE( file-name ).
 121
 122     PUT UNFORMATTED
 123       CHR(123) +
 124       'rplctn/recdisp.i "' + table-name + '" "' + desc-clause + '"' +
 125       CHR(125)
 126       SKIP.
 127
 128     OUTPUT CLOSE.
 129
 130     COMPILE VALUE( file-name ) SAVE.
 131
 132 /* _UIB-CODE-BLOCK-END */
 133 &ANALYZE-RESUME
 134
 135
 136 /* ************************  Function Implementations ***************** */
 137
 138 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION add-field-to-desc Procedure
 139 FUNCTION add-field-to-desc RETURNS CHARACTER
 140   ( INPUT-OUTPUT desc-clause AS CHAR ) :
 141 /*------------------------------------------------------------------------------
 142   Purpose:
 143     Notes:
 144 ------------------------------------------------------------------------------*/
 145
 146   IF LOOKUP( _Field._Data-Type, "RAW" ) = 0 THEN DO:
 147     IF desc-clause <> "" THEN desc-clause = desc-clause + " + ".
 148     desc-clause = desc-clause + " ~~~n" +
 149       "'" + STRING( _Field._Field-Name, "X(20)" ) + ": ' + " +
 150       "(IF Temp" + _File._File-Name + "." + _Field._Field-Name + " = ? THEN '?' ELSE STRING( Temp" + _File._File-Name + "." + _Field._Field-Name + " )) + CHR(10) ".
 151   END.
 152
 153   RETURN "".   /* Function return value. */
 154
 155 END FUNCTION.
 156
 157 /* _UIB-CODE-BLOCK-END */
 158 &ANALYZE-RESUME
 159
 160