home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / 3x400 / dspm.lzh / FFD500.PGM < prev    next >
Text File  |  1989-01-11  |  13KB  |  290 lines
  1.      H
  2.      F* PROGRAM - FILE MEMBER MAINTENANCE & SELECTION PROGRAM
  3.      F* AUTHOR  - DAVID J. KRAXNER        DATE WRITTEN - 04/12/85
  4.      F*
  5.      F*    04/13/85 DJK - MODIFIED TO OUTPUT SELECTED MEMBER TEXT VIA
  6.      F*                   PROGRAM INPUT PARAMETER.
  7.      F*    05/14/87 HJJ - ENHANCED TO DISPLAY NUMBER OF RECORDS FOR
  8.      F*                   LOGICAL FILE MEMBERS.
  9.      F*    10/20/87 HJJ - ENHANCED TO USE CPYF COMMAND.
  10.      F*
  11.      F*   TO COMPILE YOU MUST CREATE DSPFDMWK WITH THE FOLLOWING:
  12.      F*
  13.      F*   DSPFD      FILE(ffd500fm) TYPE(*MBRLIST) OUTPUT(*NONE) +
  14.      F*               OUTFILE(DSPFDMWK.XXXXXXXX) OUTMBR(DSPFDMWK)
  15.      F*
  16.      F********************************************************************
  17.      F*                   INDICATOR USAGE MAP
  18.      F********************************************************************
  19.      F*
  20.      F*     40 - GENERAL USAGE
  21.      F*
  22.      F*     53 - QAEXEC EXECUTION ERROR INDICATOR
  23.      F*     50 - READ MBR OUTFILE CONTROL
  24.      F*     55 - READ CHANGES CONTROL
  25.      F*
  26.      F*   * 90 - SLFEND, SUB-FILE END CONTROL
  27.      F*   * 91 - SLFEND, PROGRAM MESSAGE QUEUE
  28.      F*   * 95 - PROTECTS SUB-FILE SELECTION FIELD
  29.      F*   * 98 - CONDITIONS FILE MEMBER SELECTIVITY ONLY
  30.      F*
  31.      F********************************************************************
  32.      FFFD500FMCF  E                    WORKSTN      KINFDS WSDS
  33.      F                                        SFREC1KSFILE FFD500S1
  34.      FDSPFDMWKIF  E                    DISK
  35.      FLOGREC  IF  E                    DISK                           UC
  36.      E                    FL         21 01               QUAL(FILE.LIBRARY)
  37.      E                    TRC         3  5 0             RRN OF TO MBR
  38.      E                    FRC         3  5 0             RRN OF TO MBR
  39.      E                    TMB         3 10               TO MEMBER NAME
  40.      E                    FMB         3 10               FROM MEMBER NAME
  41.      E                    K      80  80 01               DSPFD Command
  42.      I            DS
  43.      I                                        1  50 MLMTXT
  44.      I                                        1  40 SFMTXT
  45.      I            DS
  46.      I                                        1  80 CMDCPY
  47.      I                                        1   5 CPY
  48.      I                                        7  27 FQUL
  49.      I                                       29  49 FQUL2
  50.      I                                       51  60 FRMMBR
  51.      I                                       62  71 TOMBR
  52.      I                                       73  80 WCOPT
  53.      I*
  54.      ICMD         DS                             80
  55.      I*   COMMAND NAME
  56.      I                                        1  10 CMD1
  57.      I*   OBJECT/LIBRARY NAME
  58.      I                                       12  32 CMD2
  59.      I*   MEMBER NAME
  60.      I                                       34  43 CMD3
  61.      IWSDS        DS
  62.      I                                    B 378 3790DSSFL#
  63.      I           SDS
  64.      I                                     *PROGRAM PGMSGQ
  65.      I                                     *STATUS  STATUS
  66.      I                                       40  46 MSGID
  67.      I                                      254 263 USERID
  68.      C/EJECT
  69.      C           *ENTRY    PLIST
  70.      C                     PARM           CLRRMV  1        CLRPFM/RMVM
  71.      C                     PARM           MEMBER 10        MEMBER SELECTED
  72.      C                     PARM           TEXT   50        MEMBER SELECTED
  73.      C*
  74.      C           CLRRMV    IFEQ 'N'                        TEST FOR NO
  75.      C                     MOVE '1'       *IN98            CLEAR OR REMOVE
  76.      C                     END                             AUTHORITY
  77.      C*
  78.      C                     MOVE '*REPLACE'WCOPT
  79.      C                     MOVE '1'       *IN90            SFLEND
  80.      C                     MOVE '1'       *IN91            SFLEND
  81.      C                     Z-ADD0         SFREC1
  82.      C*
  83.      C           *IN55     DOUEQ'1'                        ACCESS WORK
  84.      C                     READ DSPFDMWK                 55FILE RECORDS
  85.      C           *IN55     IFEQ '0'                        UNTIL ALL READ
  86.      C                     ADD  1         SFREC1
  87.      C           MLNRCD    IFEQ 0
  88.      C           MLFILA    ANDEQ'*LGL'
  89.      C                     EXSR FNDLOG
  90.      C                     END
  91.      C                     WRITEFFD500S1                 55WRITE RECORDS
  92.      C                     END
  93.      C  N55                END
  94.      C*
  95.      C           SFREC1    IFEQ 0                          DEFAULT
  96.      C                     Z-ADD1         SFREC1           WRITE
  97.      C                     WRITEFFD500S1
  98.      C                     END
  99.      C*
  100.      C                     Z-ADD1         SFLRCD
  101.      C           PROMPT    TAG                             DISPLAY SUBFILE
  102.      C                     Z-ADD0         WKCHG#  30
  103.      C                     WRITEMSGCTL                     PGMMSGQ
  104.      C                     EXFMTFFD500C1
  105.      C                     Z-ADDDSSFL#    SFLRCD
  106.      C*
  107.      C           *INKA     CABEQ'1'       ENDPGM         LRCMD 1 - EOJ
  108.      C*
  109.      C                     MOVE '0'       *IN55
  110.      C                     Z-ADD0         Q       30
  111.      C                     Z-ADD0         R       30
  112.      C           *IN55     DOUEQ'1'                        READS CHANGED
  113.      C                     READCFFD500S1                 55SUB-FILE
  114.      C           *IN55     IFEQ '0'                        RECORDS
  115.      C*
  116.      C           SFTEST    IFEQ '1'                        SELECTED FILE
  117.      C                     MOVE MLNAME    MEMBER
  118.      C                     MOVE MLMTXT    TEXT
  119.      C                     MOVE ' '       SFTEST
  120.      C                     ADD  1         WKCHG#
  121.      C                     END
  122.      C*
  123.      C           *IN98     IFEQ '0'                        PROCESS CLRPFM
  124.      C           SFTEST    IFEQ 'F'
  125.      C                     ADD  1         Q
  126.      C                     Z-ADDSFREC1    FRC,Q
  127.      C                     MOVE MLNAME    FMB,Q
  128.      C                     ADD  1         WKCHG#
  129.      C                     END
  130.      C           SFTEST    IFEQ 'T'
  131.      C                     ADD  1         R
  132.      C                     Z-ADDSFREC1    TRC,R
  133.      C                     MOVE MLNAME    TMB,R
  134.      C                     ADD  1         WKCHG#
  135.      C                     END
  136.      C           SFTEST    CASEQ'R'       MAINT            OR RMVM REQUEST
  137.      C           SFTEST    CASEQ'C'       MAINT
  138.      C                     END
  139.      C                     END
  140.      C*
  141.      C                     MOVE ' '       SFTEST           UPDATE SUB-FILE
  142.      C                     UPDATFFD500S1                   & REDISPLAY
  143.      C                     MOVE '0'       *IN95
  144.      C*
  145.      C                     END
  146.      C  N55                END
  147.      C*
  148.      C           Q         CASNE0         COPY
  149.      C                     END
  150.      C*
  151.      C           WKCHG#    CABGT0         PROMPT           RE-DISPLAY???
  152.      C*
  153.      C           ENDPGM    TAG
  154.      C*
  155.      C                     MOVE '1'       *INLR
  156.      C*
  157.      C********************************************************************
  158.      C*             PROCESSES FILE MEMBER MAINTENANCE
  159.      C********************************************************************
  160.      CSR         MAINT     BEGSR
  161.      C*
  162.      C           SFTEST    IFEQ 'C'                        SET-UP COMMAND
  163.      C                     MOVEL'CLRPFM'  CMD1             NAME TO EXECUTE
  164.      C                     EXSR QUAL                       BUILD QUALIFIED
  165.      C                     MOVELQOBJ      CMD2             FILE NAME
  166.      C                     MOVE MLNAME    CMD3
  167.      C                     EXSR EXECMD                     EXECUTE COMMAND
  168.      C           *IN53     IFEQ '0'                        SET-UP COMMAND
  169.      C                     Z-ADD0         MLNRCD
  170.      C                     END
  171.      C                     ELSE
  172.      C                     MOVEL'RMVM  '  CMD1
  173.      C                     EXSR QUAL                       BUILD QUALIFIED
  174.      C                     MOVELQOBJ      CMD2             FILE NAME
  175.      C                     MOVE MLNAME    CMD3
  176.      C                     EXSR EXECMD                     EXECUTE COMMAND
  177.      C           *IN53     IFEQ '0'                        SET-UP COMMAND
  178.      C                     Z-ADD0         MLNRCD
  179.      C                     MOVE '******'  MLCHGD
  180.      C                     MOVE '******'  MLCHGT
  181.      C                     MOVE *BLANKS   SFMTXT
  182.      C                     MOVEL'*REMOVED'SFMTXT
  183.      C                     SUB  1         MLNOMB
  184.      C                     MOVE '1'       *IN95
  185.      C                     END
  186.      C                     END
  187.      C                     ADD  1         WKCHG#
  188.      C*
  189.      C*
  190.      CSR                   ENDSR
  191.      C********************************************************************
  192.      C*             BUILD QUALIFIED OBJECT LIBRARY NAME
  193.      C********************************************************************
  194.      CSR         QUAL      BEGSR
  195.      C*
  196.      C                     MOVEA*BLANKS   FL
  197.      C                     MOVEAMLFILE    FL,1
  198.      C                     Z-ADD1         X       30
  199.      C           *BLANK    LOKUPFL,X                     40
  200.      C                     MOVE '.'       FL,X
  201.      C                     ADD  1         X
  202.      C                     MOVEAMLLIB     FL,X
  203.      C                     MOVEAFL        QOBJ   21
  204.      C*
  205.      CSR                   ENDSR
  206.      C*****************************************************************
  207.      C           FNDLOG    BEGSR
  208.      C*****************************************************************
  209.      C*
  210.      C           OPENMB    IFNE 'Y'
  211.      C                     MOVE 'Y'       OPENMB  1
  212.      C                     EXSR QUAL
  213.      C                     MOVEAFL        K,7
  214.      C                     MOVEAK         CMD
  215.      C                     EXSR EXECMD
  216.      C                     OPEN LOGREC
  217.      C                     END
  218.      C*
  219.      C                     READ LOGREC                   50
  220.      C           *IN50     IFEQ '0'
  221.      C                     Z-ADDMBBOR     MLNRCD
  222.      C                     END
  223.      C*
  224.      C                     ENDSR
  225.      C********************************************************************
  226.      C*           COPY MEMBERS TO OTHER MEMBERS
  227.      C********************************************************************
  228.      CSR         COPY      BEGSR
  229.      C*
  230.      C                     EXSR QUAL
  231.      C                     MOVEAFL        FQUL
  232.      C                     MOVEAFL        FQUL2
  233.      C*
  234.      C           *INKD     IFEQ '1'
  235.      C                     MOVEL'?'       CPY
  236.      C                     MOVE 'CPYF'    CPY
  237.      C                     ELSE
  238.      C                     MOVE 'CPYF '   CPY
  239.      C                     END
  240.      C*
  241.      C                     DO
  242.      C           FMB,1     IFNE *BLANKS
  243.      C                     MOVE FMB,1     FRMMBR
  244.      C                     END
  245.      C           TMB,1     IFNE *BLANKS
  246.      C                     MOVE TMB,1     TOMBR
  247.      C                     Z-ADD80        LENGTH           SET INITIAL
  248.      C                     CALL 'QCAEXEC'              53  VALUE FOR
  249.      C                     PARM           CMDCPY           COMMAND LENGTH
  250.      C                     PARM           LENGTH
  251.      C           FRC,1     CHAINFFD500S1             50
  252.      C           *IN50     IFEQ '0'
  253.      C                     Z-ADDMLNRCD    HLDFRM  50
  254.      C                     END
  255.      C           *IN53     IFNE '1'
  256.      C           TRC,1     CHAINFFD500S1             50
  257.      C           *IN50     IFEQ '0'
  258.      C           WCOPT     IFEQ '*REPLACE'
  259.      C                     Z-ADDHLDFRM    MLNRCD
  260.      C                     UPDATFFD500S1
  261.      C                     ELSE
  262.      C           WCOPT     IFEQ '*ADD    '
  263.      C                     ADD  HLDFRM    MLNRCD
  264.      C                     UPDATFFD500S1
  265.      C                     END
  266.      C                     END
  267.      C                     END
  268.      C                     END
  269.      C                     END
  270.      C                     END
  271.      C*
  272.      C                     ENDSR
  273.      C********************************************************************
  274.      C*           EXECUTE A COMMAND VIA QCAEXEC IBM PROGRAM
  275.      C********************************************************************
  276.      CSR         EXECMD    BEGSR
  277.      C*
  278.      C                     Z-ADD80        LENGTH 155       SET INITIAL
  279.      C                     CALL 'QCAEXEC'              53  VALUE FOR
  280.      C                     PARM           CMD              COMMAND LENGTH
  281.      C                     PARM           LENGTH
  282.      C*
  283.      C                     MOVE *BLANKS   CMD
  284.      C*
  285.      CSR                   ENDSR
  286.      C/EJECT
  287.      O/EJECT
  288. **  K - BUILDS DSPFD COMMAND
  289. DSPFD                        TYPE(*MBR) OUTPUT(*NONE) OUTFILE(LOGREC.QTEMP)
  290.