home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / 3x400 / qryf.lzh / QRYFR.RPG < prev   
Text File  |  1987-09-04  |  13KB  |  217 lines
  1.       *-PANDOL RPGIII PROGRAM DESCRIPTION---------------------------------
  2.       * REPORT TITLE: None
  3.       *
  4.       * PURPOSE: CCP for the QRYF command. Creates UDS statements for
  5.       *          the CRTQRYAPP command and reformat utility copy file
  6.       *          control records
  7.       * METHOD:  Refer to the S/38 Query Utility Reference Manual
  8.       *          Source Statement Syntax
  9.       *          This program creates the source statements based upon
  10.       *          the parms passed to it by the QRYF command.
  11.       *          The variable list FLDS contains 1 occurance for each
  12.       *          query field (limit 10). These are moved into the FLD
  13.       *          data structure for processing.
  14.       *
  15.       * INVOKED:  QRYF command --> QRYF CLP  --> QRYFR
  16.       * CALLS:    None
  17.       * SCHEDULE: On request
  18.       *
  19.       * PROGRAMMER:  Robert   Hughes         DATE: 08/87
  20.       * REVISED:     F------- L--------      DATE: mm/yy
  21.       *  REASON:
  22.       *
  23.       *--------------------------------------------------------------
  24.      FQCLSRC  O   F      92            DISK
  25.      FQCLSRC2 O   F      92            DISK
  26.      E                    CL      1  12 65               QRY DEF
  27.      E                    SKP        11  1               SKIP PARM FLAG
  28.      E                    SRT         9 10               SORT FIELDS
  29.      E                    C          65  1               WORK FOR CL
  30.      E                    WRK       510  1               STRING ARRAY
  31.      IFLD         DS
  32.      I                                        1   2 SPAC1
  33.      I                                        3  12 FIELD
  34.      I                                       13  13 OPR
  35.      I                                       14  14 EDIT
  36.      I                                       15  15 SPB
  37.      I                                       16  17 SPAC2
  38.      I                                    B  18  190L#
  39.      I                                       20  29 LB1
  40.      I                                       30  39 LB2
  41.      I                                       40  49 LB3
  42.      IFLDS        DS
  43.      I                                    B   1   20F#
  44.      I                                        3 512 WRK
  45.      IBIN2        DS
  46.      I                                    B   1   20B2
  47.      C           *ENTRY    PLIST
  48.      C                     PARM           FILE   21
  49.      C                     PARM           FMT    10
  50.      C                     PARM           TITLE  32
  51.      C                     PARM           FLDS
  52.       *-------------------------------------------------------------------
  53.      C                     DO   4         SEQ     60       LOOP THRU 1ST 4
  54.       *--------------------------
  55.      C           SEQ       IFEQ 1                          IF QRYAPP
  56.      C                     MOVEACL,SEQ    C                LOAD WORK
  57.      C                     MOVEAFILE      C,15             LOAD DATA
  58.      C                     EXCPTOUTPUT                     WRITE DEF
  59.      C                     END                             END
  60.       *--------------------------
  61.      C           SEQ       IFEQ 2                          IF 1ST OUTPUT
  62.      C                     MOVEACL,SEQ    C                LOAD WORK
  63.      C                     MOVEATITLE     C,15             LOAD DATA
  64.      C                     EXCPTOUTPUT                     WRITE DEF
  65.      C                     END                             END
  66.       *--------------------------
  67.      C           SEQ       IFEQ 3                          IF 2ND OUTPUT
  68.      C                     MOVEACL,SEQ    C                LOAD WORK
  69.      C                     MOVEATITLE     C,15             LOAD DATA
  70.      C                     EXCPTOUTPUT                     WRITE DEF
  71.      C                     END                             END
  72.       *--------------------------
  73.      C           SEQ       IFEQ 4                          IF QRYFMT
  74.      C                     MOVEACL,SEQ    C                LOAD WORK
  75.      C                     MOVEAFMT       C,15             LOAD DATA
  76.      C                     EXCPTOUTPUT                     WRITE DEF
  77.      C                     END                             END
  78.       *--------------------------
  79.      C                     END                             DO 4
  80.       *-------------------------------------------------------------------
  81.      C                     DO   F#        K       30       DO FOR EA FLD
  82.      C           K         MULT 2         I       30       COMPUTE
  83.      C                     SUB  1         I                OFFSET
  84.      C                     MOVEAWRK,I     BIN2             TO LIST
  85.      C                     SUB  1         B2               SET OFFSET
  86.      C                     MOVEAWRK,B2    FLD              GET STRUCTUR
  87.       *-----------
  88.      C           5         DO   8         X       30       LOOP THRU DEF
  89.       *--------------------------
  90.      C           X         IFEQ 5                          IF FLD KEYWRD
  91.      C                     MOVEACL,X      C                LOAD WORK
  92.      C                     MOVEAFIELD     C,15             LOAD DATA
  93.      C                     MOVEAC         CL,X             SAVE IN WORK
  94.      C                     Z-ADDX         LSTX    30       MARK HIGHEST
  95.      C                     MOVE 'N'       SKP,X            MARK NO SKIP
  96.      C                     END                             END
  97.       *--------------------------
  98.      C           X         IFEQ 6                          IF FLD KEYWRD
  99.      C           OPR       IFEQ 'S'                        IF SUM
  100.      C                     MOVEACL,X      C                LOAD WORK
  101.      C                     MOVEAC         CL,X             SAVE IN WORK
  102.      C                     Z-ADDX         LSTX             MARK HIGHEST
  103.      C                     MOVE 'N'       SKP,X            MARK NO SKIP
  104.      C                     ELSE                            ELSE SKIP
  105.      C                     MOVE 'Y'       SKP,X            MARK SKIP
  106.      C           OPR       IFGE '1'                        IF SORT
  107.      C           OPR       ANDLE'9'                        REQUEST
  108.      C                     MOVE OPR       S       10       GET ORDER
  109.      C                     MOVE FIELD     SRT,S            AND SAVE
  110.      C                     END                             END IF SORT
  111.      C                     END                             END
  112.      C                     END                             END IF
  113.       *--------------------------
  114.      C           X         IFEQ 7                          IF FLD KEYWRD
  115.      C           SPB       IFNE '*'
  116.      C                     MOVEACL,X      C                LOAD WORK
  117.      C                     MOVEASPB       C,15             LOAD DATA
  118.      C                     MOVEAC         CL,X             SAVE IN WORK
  119.      C                     Z-ADDX         LSTX             MARK HIGHEST
  120.      C                     MOVE 'N'       SKP,X            MARK NO SKIP
  121.      C                     ELSE                            ELSE SKIP
  122.      C                     MOVE 'Y'       SKP,X            MARK NO SKIP
  123.      C                     END                             END
  124.      C                     END                             END
  125.       *--------------------------
  126.      C           X         IFEQ 8                          IF FLD KEYWRD
  127.      C           EDIT      IFNE '*'
  128.      C                     MOVEACL,X      C                LOAD WORK
  129.      C                     MOVEAEDIT      C,15             LOAD DATA
  130.      C                     MOVEAC         CL,X             SAVE IN WORK
  131.      C                     Z-ADDX         LSTX             MARK HIGHEST
  132.      C                     MOVE 'N'       SKP,X            MARK NO SKIP
  133.      C                     ELSE                            ELSE SKIP
  134.      C                     MOVE 'Y'       SKP,X            MARK NO SKIP
  135.      C                     END                             END
  136.      C                     END                             END
  137.       *--------------------------
  138.      C                     END                             END  5->8
  139.       *--------------------------
  140.      C                     MOVEA'YYY'     SKP,9            MARK ALL SKIP
  141.      C           L#        IFEQ 1                          IF 1 LABEL
  142.      C           LB1       IFEQ '*DFT'                     IF DEFAULT
  143.      C                     Z-ADD0         L#               BLANK ALL
  144.      C                     ELSE                            ELSE
  145.      C                     MOVEACL,9      C                LOAD WORK
  146.      C                     MOVEALB1       C,15             LOAD DATA
  147.      C                     MOVEAC         CL,9             SAVE IN WORK
  148.      C                     Z-ADD9         LSTX             MARK HIGHEST
  149.      C                     MOVE 'N'       SKP,9            MARK NO SKIP
  150.      C                     END                             END
  151.      C                     END                             END
  152.      C           L#        IFEQ 2                          IF 1 LABEL
  153.      C                     MOVEACL,10     C                LOAD WORK
  154.      C                     MOVEALB1       C,15             LOAD DATA
  155.      C                     MOVEALB2       C,28             LOAD DATA
  156.      C                     MOVEAC         CL,10            SAVE IN WORK
  157.      C                     Z-ADD10        LSTX             MARK HIGHEST
  158.      C                     MOVE 'N'       SKP,10           MARK NO SKIP
  159.      C                     END                             END
  160.      C           L#        IFEQ 3                          IF 1 LABEL
  161.      C                     MOVEACL,11     C                LOAD WORK
  162.      C                     MOVEALB1       C,15             LOAD DATA
  163.      C                     MOVEALB2       C,28             LOAD DATA
  164.      C                     MOVEALB3       C,41             LOAD DATA
  165.      C                     MOVEAC         CL,11            SAVE IN WORK
  166.      C                     Z-ADD11        LSTX             MARK HIGHEST
  167.      C                     MOVE 'N'       SKP,11           MARK NO SKIP
  168.      C                     END                             END
  169.       *---------------------------------------------------------------
  170.      C           5         DO   LSTX      X                LOOP THRU FLD
  171.      C           SKP,X     IFEQ 'N'                        IF NOT SKIP
  172.      C                     MOVEACL,X      C                LOAD WORK
  173.      C           X         IFEQ LSTX                       IF LAST PARM
  174.      C                     MOVE ' '       C,55             BLANK +
  175.      C                     END
  176.      C                     ADD  1         SEQ
  177.      C                     EXCPTOUTPUT
  178.      C                     END                             END IF NOT SKIP
  179.      C                     END                             END LOOP
  180.       *---------------------------------------------------------------
  181.      C                     END                             END W F#
  182.       *---------------------------------------------------------------
  183.      C                     DO   9         X                WRITE SORTS
  184.      C           SRT,X     IFNE *BLANKS                    IF FLD NAME
  185.      C                     MOVEACL,12     C                LOAD WORK
  186.      C                     MOVE SRT,X     FIELD            LOAD TO 10A
  187.      C                     MOVEAFIELD     C,15             LOAD DATA
  188.      C                     EXCPTOUTPUT                     WRITE DEF
  189.      C                     END                             END NE BLK
  190.      C                     END                             END DO 9
  191.       *
  192.      C                     EXCPTLAST                       CRT REFMT COPY
  193.      C                     SETON                     LR
  194.      OQCLSRC  E                OUTPUT
  195.      O                         SEQ        6
  196.      O                                   12 '000000'
  197.      O                                      '      HFILE'
  198.      O                                      '       FDC '
  199.      O                         C         77
  200.      OQCLSRC2 E                LAST
  201.      O                                   22 '000001000000     HFILE'
  202.      O        E                LAST
  203.      O                                   22 '000001000000     FDC  '
  204. **  QRY STATEMENTS
  205. QRYAPP   FILE(\\\\\\\\\\.\\\\\\\\\\) TITLE('QRYF PGM GEN')
  206. OUTPUT  HEAD('\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\') +
  207.        COVER('\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\')
  208. QRYFMT RCDFMT(\\\\\\\\\\)
  209. QRYFLD  FIELD(\\\\\\\\\\)                             +
  210.           SUM(*YES)                                   +
  211.         SPACE(\) DFTSPC(*NO)                          +
  212.        EDTCDE(\)                                      +
  213.        LABEL('\\\\\\\\\\' ' ' ' ')
  214.        LABEL('\\\\\\\\\\' '\\\\\\\\\\' ' ')
  215.        LABEL('\\\\\\\\\\' '\\\\\\\\\\' '\\\\\\\\\\')
  216. SORT    FIELD(\\\\\\\\\\) SUBTOT(*YES)
  217.