F********************************************************************
     F*                                                                  *
     F*            Demonstrate use of client server process              *
     F*                                                                  *
     F********************************************************************
DSPF FLEGACYD   CF   E             WORKSTN
     F*
     D*
     D PGMDS          SDS
     D  @PGM                   1     10
     D  #PGM                   1     10
     D  #JOB                 244    253
     D  #DEV                 244    253
     D  #RF                  244    245
     D  #USER                254    263
     D  #JNR                 264    269
     D*
     D* Data structures for client/server programs
     D*
     D PARMS         E DS                  EXTNAME(BCSDS)
     D DSLEGBCH      E DS                  EXTNAME(DSLEGBCH)
     C**
     C*
     C****************************************************************
     C*  MAINLINE PROCESSING
     C****************************************************************
     C*
     C*  PROCESS INITIALIZATION
     C                   EXSR      INIT
     C                   EXSR      DSPLY
     C                   SETON                                        LR
     C*
     C****************************************************************
     C*  DISPLAY SCREEN
     C****************************************************************
     C*
     C     DSPLY         BEGSR
     C     *IN03         DOUEQ     *ON
     C                   EXFMT     DISPLAY
     C* Do until user hits F3 to leave
     C     *IN03         IFEQ      *ON
     C                   LEAVE
     C                   END
     C* Do batch work
     C                   EXSR      WORK
     C                   ENDDO
     C                   ENDSR
     C*
     C****************************************************************
     C*  DO heavy work in batch
     C****************************************************************
     C*
     C     WORK          BEGSR
     C*
     C*
     C* FORMAT PARMS
     C*     OUR PGM
     C                   MOVEL(P)  @PGM          PPGMC
     C*     PGM TO CALL
     C                   MOVEL(P)  'LEGBCH'      PPGM
     C*     OUR PARM DATA
     C                   MOVEL(P)  DSLEGBCH      PDATA
     C                   EXSR      SNDRCV
     C*  FORMAT RETURNING PARMS
     C     RCVDCOUNT     IFEQ      0
     C                   MOVEL     PDATA         DSLEGBCH
     C                   END
     C
     C*
     C                   ENDSR
     C*
     C********************************************************************
     C*  SNDRCV - SEND AND RECEIVE DATA QUEUE ENTRIES
     C********************************************************************
     C*
     C     SNDRCV        BEGSR
     C*
     C*
     C* SEND REQUEST
     C                   Z-ADD     5000          PLEN
     C                   CALL      'QSNDDTAQ'
     C                   PARM                    PBCHQ            10
     C                   PARM                    PLIB             10
     C                   PARM                    PLEN              5 0
     C                   PARM                    PARMS
     C*
     C*
     C*
     C* RECEIVE RESPONSE
     C*  TRY TWO TIMES AND THEN SEND ERROR MESSAGE
     C                   Z-ADD     0             RCVDCOUNT         1 0
     C     RCVDCOUNT     DOUGE     2
     C                   Z-ADD     60            PWAIT
     C                   Z-ADD     0             PLEN
     C                   CALL      'QRCVDTAQ'
     C                   PARM                    PINTQ
     C                   PARM                    PLIB             10
     C                   PARM                    PLEN              5 0
     C                   PARM                    PARMS
     C                   PARM                    PWAIT             5 0
     C*  FORMAT RETURNING PARMS
     C     PLEN          IFGT      0
     C                   Z-ADD     0             RCVDCOUNT
     C                   LEAVE
     C                   ELSE
     C                   ADD       1             RCVDCOUNT
     C                   END
     C* SEND SERVER NOT RESPONDING ERROR MESSAGE
     C     RCVDCOUNT     IFGE      2
     C****     Code to send error messages to your screens using
     C****      your shop preferences
     C****
     C****               ELSE
     C* Try to Restart server job
     C                   MOVEL     *BLANKS       PINTQ
     C                   MOVEL     *BLANKS       PBCHQ
     C                   MOVEL     *BLANKS       PLIB
     C                   CALL      'BCS001C'
     C                   PARM                    PINTQ            10
     C                   PARM                    PBCHQ            10
     C                   PARM                    PLIB             10
     C                   END
     C                   ENDDO
     C                   ENDSR
     C*
     C*
     C****************************************************************
     C*  PROGRAM INITIALIZATION SUBROUTINE
     C****************************************************************
     C*
     C     INIT          BEGSR
     C*
     C*  set up client server job, get parms
     C*
     C                   MOVEL     *BLANKS       PINTQ
     C                   MOVEL     *BLANKS       PBCHQ
     C                   MOVEL     *BLANKS       PLIB
     C                   CALL      'BCS001C'
     C                   PARM                    PINTQ            10
     C                   PARM                    PBCHQ            10
     C                   PARM                    PLIB             10
     C*
     C* Clear screen field
     C                   MOVEL     *BLANKS       MSG
     C                   ENDSR
     C*