Sample Programs and Database Definition › Sample Batch Program › Batch Input to the DML Precompiler

Batch Input to the DML Precompiler

The following is sample batch input to the DML precompiler for PL/I.

 //SYSIPT  DD  *
 /*RETRIEVAL*/
 /*DMLIST*/
 /*NO_ACTIVITY_LOG*/
 /*SCHEMA_COMMENTS*/
 DEPTRPT: PROC OPTIONS (MAIN) REORDER;
                 /* DECLARE SUBSCHEMA AND MODE */
 DCL  (EMPSS01 SUBSCHEMA, EMPSCHM SCHEMA VERSION 100)
                   MODE (BATCH) DEBUG;

                /* REQUIRED DECLARATIVES */
 DCL  IDMS ENTRY OPTIONS(INTER,ASM);
 DCL  ABORT ENTRY OPTIONS(INTER,ASM);
 DCL  ADDR BUILTIN;

    /* CONSTANTS */
 DCL  DEPT_HEADER     CHAR (11) INIT ('DEPT REPORT');
 DCL  1 HEAD_LINE,
     5 HEAD_DEPT_ID   CHAR (9) INIT ('DEPT ID '),
     5 HEAD_EMP_ID   CHAR (8) INIT ('EMP ID '),
     5 HEAD_LNAME    CHAR (17) INIT ('LAST NAME    '),
     5 HEAD_FNAME    CHAR (10) INIT ('FIRST NAME');

 DCL  PRTHEAD       CHAR (44) DEFINED HEAD_LINE;

    /* LOGICAL CONSTANTS */
 DCL  YES         BIT(1)  INIT ('1'B);
 DCL  NO         BIT(1)  INIT ('0'B);
 DCL  EOF         BIT(1)  INIT ('0'B);

 DCL  1 PROGRAM_FLAGS,
     5 DB_END_OF_SET   BIT(1)  INIT ('0'B);

     /* FILE DECLARATIONS */
 DCL  INFILE FILE RECORD INPUT ENV (F BLKSIZE(80));
 DCL  OUTFILE FILE RECORD OUTPUT ENV (F RECSIZE(133) CTLASA );
 DCL  SYSPRINT FILE PRINT;
     /*  THE FOLLOWING RECORDS ARE DEFINED THROUGH IDD.    */
     /* THE DML PRECOMPILER AUTOMATICALLY CONVERTS HYPHENS */
     /*  TO UNDERSCORES.                   */

 INCLUDE IDMS (DEPT-IN-REC);
 INCLUDE IDMS (PRT-OUT-REC);
     /* REDEFINE PRT_OUT_REC */
 DCL  PRTREC         CHAR (44) DEFINED PRT_OUT_REC;

 DCL   1 PRINT_AREA,
      5 CC         CHAR (1),
      5 PRINT_LINE     CHAR (132);

 DCL   1 SPACES        CHAR (132) INIT ( (132) ' ');

     /* POSSIBLE VALUES FOR CC             */
 DCL   1 CONTROL_CHARACTERS,
      5 NEW_PAGE      CHAR (1) INIT ('1'),
      5 SINGLE_SPACE    CHAR (1) INIT (' '),
      5 DOUBLE_SPACE    CHAR (1) INIT ('0'),
      5 TRIPLE_SPACE    CHAR (1) INIT ('-'),
      5 OVERPRINT     CHAR (1) INIT ('+');

 INCLUDE IDMS (SUBSCHEMA_CTRL);
 INCLUDE IDMS (DEPARTMENT);
 INCLUDE IDMS (EMPLOYEE);
   /***********************************************************/
   /*  PROCESSING FOLLOWS                  */
                /* OPEN THE FILES         */
                /* INFILE ── INPUT         */
                /* OUTFILE ── OUTPUT        */
                /* SYSPRINT ── USED BY IDMS_STATUS */
       OPEN FILE (INFILE);
       OPEN FILE (OUTFILE);
       OPEN FILE (SYSPRINT);
       ON ENDFILE (INFILE) EOF = YES;

   /*  BIND RUN UNIT AND RECORDS EXPLICITLY */
       BIND RUN_UNIT
         NODENAME ('')
         DBNAME ('');

       CALL IDMS_STATUS;
       BIND RECORD (EMPLOYEE);
       CALL IDMS_STATUS;
       BIND RECORD (DEPARTMENT);
       CALL IDMS_STATUS;
       READY;
       CALL IDMS_STATUS;
       READ FILE (INFILE) INTO (DEPT_IN_REC);

     DO WHILE ( EOF);

       DB_END_OF_SET = NO;
       DEPT_ID_0410 = DEPT_ID_IN;
       OBTAIN CALC RECORD (DEPARTMENT);
                     /* 0326 MEANS   */
                     /* DEPT NOT FOUND */
       IF ERROR_STATUS = '0326' THEN CALL NO_DEPT;
       ELSE
        DO;
         IF SET (DEPT_EMPLOYEE) EMPTY THEN CALL NO_EMP;
         ELSE
          CALL NEW_DEPT;
          DO UNTIL (DB_END_OF_SET);
            OBTAIN NEXT RECORD (EMPLOYEE)
              SET (DEPT_EMPLOYEE);
            IF ERROR_STATUS = '0307' THEN
              DB_END_OF_SET = YES;
            ELSE
              CALL IDMS_STATUS;
            IF DB_END_OF_SET THEN
             DO;
             /* MOVE FIELDS TO */
             /* OUTPUT RECORD */
              DEPT_ID_OUT  = DEPT_ID_0410;
              EMP_ID_OUT  = EMP_ID_0415;
              EMP_LNAME_OUT = EMP_LAST_NAME_0415;
              EMP_FNAME_OUT = EMP_FIRST_NAME_0415;
              CC      = DOUBLE_SPACE;
              PRINT_LINE  = SPACES;
              PRINT_LINE  = PRTREC;
              CALL PRINT_A_LINE;
             END;  /* END PRINTING DO */
          END;  /* END DO UNTIL */
         END;  /* END 0326 ELSE DO */

       READ FILE (INFILE) INTO (DEPT_IN_REC);
     END;   /* END DO WHILE EOF */
     CALL END_PROCESSING;
 NEW_DEPT: PROC;
      PRINT_LINE = SPACES;    /* NEW PAGE FOR EACH */
      CC = NEW_PAGE;       /* DEPARTMENT    */
      PRINT_LINE = DEPT_HEADER;
      CALL PRINT_A_LINE;

      PRINT_LINE = SPACES;
      CC = DOUBLE_SPACE;
      PRINT_LINE = DEPT_ID_0410;
      CALL PRINT_A_LINE;

      PRINT_LINE = SPACES;
      CC = DOUBLE_SPACE;
      PRINT_LINE = PRTHEAD;
      CALL PRINT_A_LINE;

 END NEW_DEPT;

 NO_DEPT: PROC;
      PRINT_LINE = SPACES;
      CC = NEW_PAGE;
      PRINT_LINE = DEPT_ID_IN;
      CALL PRINT_A_LINE;
      PRINT_LINE = SPACES;
      CC = DOUBLE_SPACE;
      PRINT_LINE = '** DEPARTMENT SPECIFIED ABOVE NOT FOUND **';
      CALL PRINT_A_LINE;
 END NO_DEPT;
 NO_EMP: PROC;
      PRINT_LINE = SPACES;
      CC = NEW_PAGE;
      PRINT_LINE = DEPT_ID_IN;
      CALL PRINT_A_LINE;

      PRINT_LINE = SPACES;
      CC = DOUBLE_SPACE;
      PRINT_LINE = DEPT_ID_0410;
      CALL PRINT_A_LINE;

      PRINT_LINE = SPACES;
      CC = DOUBLE_SPACE;
      PRINT_LINE = '** DEPARTMENT SPECIFIED IS EMPTY ***';
      CALL PRINT_A_LINE;
 END NO_EMP;

 END_PROCESSING: PROC;
     FINISH;
     CLOSE FILE (INFILE);
     CLOSE FILE (OUTFILE);
     CLOSE FILE (SYSPRINT);
 END END_PROCESSING;

 PRINT_A_LINE: PROC;
  WRITE FILE (OUTFILE) FROM (PRINT_AREA);
 END PRINT_A_LINE;


       INCLUDE IDMS (IDMS_STATUS);

 END DEPTRPT;