home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / 3x400 / crtoutf.lzh / CPP1721.RPG < prev    next >
Text File  |  1985-12-02  |  5KB  |  111 lines
  1.       /TITLE  Create DDS source using format of IBM-supplied OUTFILE.
  2.       *
  3.       *       Program - CPP1721  --  CRTOUTF
  4.       *
  5.       *       (c) Copyright 1985 by Q38.
  6.       *
  7.      FQDDSSRC O   F      92            DISK
  8.      E                    FL         11 01
  9.      E                    SZ         23 01
  10.      E                    KF        128 10
  11.      IFMT         DS
  12.      I                                       01  10 FILE
  13.      I                                       11  20 RCDFMT
  14.      IFORMAT      DS
  15.      I                                    B  01  020FBIN
  16.      I                                       03  22 FMTF1
  17.      I                                       23  42 FMTF2
  18.      ISIZE        DS
  19.      I                                    B  01  020SBIN
  20.      I                                    P  03  070SIZ1
  21.      I                                    P  08  100SIZ2
  22.      I                                    P  11  130SIZ3
  23.      IKEYFLD      DS
  24.      I                                    B  01  020KBIN
  25.      I                                       031282 KF
  26.      C           *ENTRY    PLIST
  27.      C                     PARM           FORMAT
  28.      C                     PARM           SIZE
  29.      C                     PARM           KEYFLD
  30.      C                     PARM           SIZE1   8
  31.      C                     PARM           SIZE2   5
  32.      C                     PARM           SIZE3   5
  33.      C/SPACE
  34.      C           SIZ1      IFEQ 0
  35.      C*   Convert BINARY SIZE to string.
  36.      C                     MOVEL'*NOMAX'  SIZE1
  37.      C                     MOVE *ALL' '   SIZE2
  38.      C                     MOVE *ALL' '   SIZE3
  39.      C                     ELSE
  40.      C                     MOVE SIZ1      SIZE1
  41.      C                     MOVE SIZ2      SIZE2
  42.      C                     MOVE SIZ3      SIZE3
  43.      C                     END
  44.      C/SPACE
  45.      C           FMTF1     IFEQ '*DSPFD'
  46.      C*   IF DSPFD format is requested,
  47.      C*   then use second element as format.
  48.      C                     MOVELFMTF2     FMT
  49.      C                     ELSE
  50.      C                     MOVELFMTF1     FMT
  51.      C                     END
  52.      C/SPACE
  53.      C*   Source file house keeping.
  54.      C                     Z-ADDUDATE     D#      60
  55.      C                     Z-ADD1         S#      62
  56.      C                     Z-ADD1         X       60
  57.      C*   Insert SIZE parameter element into
  58.      C*   source file as a comment record.
  59.      C                     MOVEASIZE1     SZ,1
  60.      C           *BLANK    LOKUPSZ,X                     10
  61.      C                     ADD  1         X
  62.      C                     MOVEASIZE2     SZ,X
  63.      C           *BLANK    LOKUPSZ,X                     10
  64.      C                     ADD  1         X
  65.      C                     MOVEASIZE3     SZ,X
  66.      C           *BLANK    LOKUPSZ,X                     10
  67.      C                     MOVE ')'       SZ,X
  68.      C                     EXCPTSIZOUT
  69.      C/SPACE
  70.      C*   Build FORMAT keyword
  71.      C                     ADD  1         S#
  72.      C                     Z-ADD1         X
  73.      C                     MOVEAFILE      FL,1
  74.      C           *BLANK    LOKUPFL,X                     10
  75.      C                     MOVE ')'       FL,X
  76.      C                     EXCPTDDSOUT
  77.      C/SPACE
  78.      C           KBIN      IFGT 0
  79.      C*   If key fields are requested, then
  80.      C*   build key field source statements.
  81.      C           KF,1      IFNE '0'
  82.      C                     DO   KBIN      X
  83.      C                     MOVE KF,X      KFIELD 10
  84.      C                     ADD  1         S#
  85.      C                     EXCPTKEYOUT
  86.      C                     END
  87.      C                     END
  88.      C                     END
  89.      C                     MOVEL'1'       *INLR
  90.      C/SPACE
  91.      OQDDSSRC E                SIZOUT
  92.      O                         S#         6
  93.      O                         D#        12
  94.      O                                   19 'A*'
  95.      O                                 +002 'File  SIZE('
  96.      O                         SZ      +000
  97.      OQDDSSRC E                DDSOUT
  98.      O                         S#         6
  99.      O                         D#        12
  100.      O                                   18 'A'
  101.      O                                   29 'R'
  102.      O                         RCDFMT    40
  103.      O                                   63 'FORMAT('
  104.      O                         FL      +000
  105.      OQDDSSRC E                KEYOUT
  106.      O                         S#         6
  107.      O                         D#        12
  108.      O                                   18 'A'
  109.      O                                   29 'K'
  110.      O                         KFIELD    40
  111.