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

Online Input to the DML Precompiler

The following is the PL/I online program input to the DML precompiler.

 /*RETRIEVAL*/
 /*DMLIST*/
 /*NO_ACTIVITY_LOG*/
 /*SCHEMA_COMMENTS*/
 EMPDISP: PROC OPTIONS (MAIN) REORDER;
 DCL  (EMPSS01 SUBSCHEMA, EMPSCHM SCHEMA VERSION 100)
                   MODE (IDMS_DC) DEBUG;
 DCL  IDMSPLI ENTRY OPTIONS(INTER,ASM);
 DCL  ADDR BUILTIN;
 DCL  STRING BUILTIN;
 DCL  (EMPLMAP MAP) TYPE (STANDARD);

 DCL  TASK_CODE      CHAR (8);
 DCL  EMPDISP       CHAR (8) INIT ('EMPDISP');
 DCL  EMPDISP2      CHAR (8) INIT ('EMPDISP2');
 DCL  DC_AID_IND_V    CHAR (1);
     /* LOGICAL CONSTANTS */
 DCL  YES         BIT(1)  INIT ('1'B);
 DCL  NO         BIT(1)  INIT ('0'B);
 DCL  1 PROGRAM_MESSAGES,
      3 DISPLAY_MSG   CHAR (36)
       INIT (' EMPLOYEE INFORMATION DISPLAYED '),
      3 NOT_FOUND_MSG    CHAR (37)
       INIT (' SPECIFIED EMPLOYEE NUMBER NOT FOUND ');

 INCLUDE IDMS (SUBSCHEMA_CTRL);

 INCLUDE IDMS (EMPLOYEE);
 INCLUDE IDMS (MAP_CONTROLS);
 /*    PROCESSING FOLLOWS             */

 MAIN_LINE: BEGIN;
                  /* ESTABLISH ADDRESSABILITY FOR */
       BIND MAP (EMPLMAP);
       CALL IDMS_STATUS;
       BIND MAP (EMPLMAP) RECORD (EMPLOYEE);
       CALL IDMS_STATUS;
                  /* DETERMINE THE TASK CODE */
       ACCEPT TASK CODE INTO (TASK_CODE);
       CALL IDMS_STATUS;

       IF TASK_CODE = EMPDISP
       THEN CALL FIRST_TIME;
       IF TASK_CODE = EMPDISP2
       THEN CALL SECOND_TIME;



              /* OTHERWISE RETURN TO IDMS DC */
       DC RETURN;

 FIRST_TIME: PROC;
  MODIFY MAP (EMPLMAP)
    FOR ALL BUT DFLD (EMP_ID_0415)
    ATTRIBUTES PROTECTED;

  MAP OUT(EMPLMAP)
    IO OUTPUT DATA YES NEWPAGE;
  CALL IDMS_STATUS;
  DC RETURN NEXT TASK CODE(EMPDISP2);
 END FIRST_TIME;

 SECOND_TIME: PROC;
   MAP IN (EMPLMAP)
    IO INPUT DATA YES;
   CALL IDMS_STATUS;
                 /* CHECK WHICH PF KEY WAS PRESSED */
   INQUIRE MAP(EMPLMAP)
     MOVE AID TO (DC_AID_IND_V);

                 /* STOP IF PA1 (%) WAS PRESSED */
   IF DC_AID_IND_V = '%'
     THEN DC RETURN;
   BIND RUN_UNIT;
   CALL IDMS_STATUS;
   BIND RECORD (EMPLOYEE);
   CALL IDMS_STATUS;
   READY AREA (EMP_DEMO_REGION);
   CALL IDMS_STATUS;
                /* OBTAIN THE RECORD */
   OBTAIN CALC RECORD (EMPLOYEE);
   IF ERROR_STATUS = '0326' THEN CALL NO_EMP;
   CALL IDMS_STATUS;
   FINISH;
   CALL IDMS_STATUS;
             /* TRANSMIT THE DATA BACK TO THE SCREEN */
   MAP OUT(EMPLMAP)
    IO OUTPUT DATA YES NEWPAGE
    MESSAGE(DISPLAY_MSG) LENGTH(36);
   CALL IDMS_STATUS;
   DC RETURN NEXT TASK CODE(EMPDISP2);

 END SECOND_TIME;

 NO_EMP: PROC;
             /* DO THIS IF EMPLOYEE NOT FOUND */
  MAP OUT(EMPLMAP)
    IO OUTPUT DATA YES NEWPAGE
    MESSAGE(NOT_FOUND_MSG) LENGTH(37);
  CALL IDMS_STATUS;
  DC RETURN NEXT TASK CODE(EMPDISP2);
 END NO_EMP;

       INCLUDE IDMS (IDMS_STATUS);
 END MAIN_LINE; /* END MAIN_LINE */
 END EMPDISP;