Accessing Programs from Global Subsystem › Establishing a Host Command Environment › Example of a REXX EXEC

Example of a REXX EXEC

The following REXX EXEC example illustrates the use of the DELIVER host command environment:

#DESC TEST OF THE DELIVER HOST COMMAND ENVIRONMENT
#SOURCE
/*:RMOGRW.TEST1
/CONTROL DATABASE=DELIVER.SYSTEM1
/OUTPUT DISTID COL(1)
/OUTPUT DDEST  COL(35)
/DEFINE (I) BIN
/DO I=1 TO NA BY 1
/   OUTPUT A COL(55)
/   NEXT A
/END

*/
   TRACE OFF
   XPDELIVER.DBASE=DELIVER.SYSTEM1'
   CALL QUEUEPGM('RMOGRW.TEST1')
   ADDRESS DELIVER '/REPORT'
   NUM = QUEUED()
   RECORD.0 = NUM
   DO I = 1 TO NUM
      PULL RECORD.I
   END
   TRACE ALL
   DDNAME = ALLOC(,'NEW DELETE','PERM','DATA',,,'TRK 10',,
                'PS','FB','256','2560')
   SAY DDNAME
   DCB = SAM('OBTAIN','LOCAL','DATA','OUTPUT')
   SAY DCB
   X = SAM('OPEN',DCB)
   SAY X
   DODBB = 'NO'
   DO I = 1 TO RECORD.0
      A1 = SUBSTR(RECORD.I,30,10)
      IF A1 = 'JIM SMITH' THEN DO
         OUTRECORD = 'D'||SUBSTR(RECORD.I,1,8)
         X = SAM('PUT',DCB,OUTRECORD,' ')
         SAY OUTRECORD
         DODBB='YES'
      ELSE DO
         SAY 'SKIPPING' RECORD.I
      END

(BLOCK TEXT C)   END
   X = SAM('CLOSE', DCB)
   IF DODBB = 'YES' THEN DO
      ADDRESS DELIVER '/DISTDEF FUNCTION=(1) DISTID=(3)'
      SAY RC
      CALL PRINTRESULT
   END
   X = DEALLOC ('DATA')
   ADDRESS DELIVER 'ADDS CYLINDER=3'
   CALL PRINTRESULT
EXIT

QUEUEPGM:
   PARSE ARG NAME
   KEY = '/*:'||NAME
   KEYL = LENGTH(KEY)
   LINENUM = 1
   DONE = 0
   DO WHILE DONE=0
      LINE = SOURCELINE(LINENUM)
      LINENUM = LINENUM + 1
      IF SUBSTR(LINE,1,KEYL) = KEY THEN DO
         DO WHILE DONE=0
            LINE = SOURCELINE(LINENUM)
            LINENUM = LINENUM + 1
            IF SUBSTR(LINE,1,2) = '*/' THEN DO
               DONE = 1
            END
            ELSE DO
               QUEUE LINE
            END
         END
      END
      ELSE IF SUBSTR(LINE,1,8) = 'QUEUEPGM' THEN DO
         DONE = 1
      END
RETURN

PRINTRESULT:
   HOWMANY = QUEUED()
   SAY HOWMANY
   DO I = 1 TO HOWMANY
      PULL RECORD
      SAY RECORD
   END
RETURN