Sample Programs and Database Definition › Sample Online Program › Output from the DML Precompiler

Output from the DML Precompiler

The following is the online program as it has been output from the DML precompiler.

IDMSDMLP  nn.n               CA, INC. DML PROCESSOR FOR PL/I DATE   TIME   PAGE
               - - LISTING OF MESSAGES - -                mm/dd/yy hhmmsshh  0001

         00001    /*RETRIEVAL*/
         00002    /*DMLIST*/
         00003    /*NO_ACTIVITY_LOG*/
         00004    /*SCHEMA_COMMENTS*/
         00005    EMPDISP: PROC OPTIONS (MAIN) REORDER;
DMLP     00007    DCL  (EMPSS01 SUBSCHEMA, EMPSCHM SCHEMA VERSION 100)
         00008                     MODE (IDMS_DC) DEBUG;
         00009    DCL  IDMSPLI ENTRY OPTIONS(INTER,ASM);
         00010    DCL  ADDR BUILTIN;
         00011    DCL  STRING BUILTIN;
DMLP     00013    DCL  (EMPLMAP MAP) TYPE (STANDARD);
         00014
         00015    DCL  TASK_CODE      CHAR (8);
         00016    DCL  EMPDISP       CHAR (8) INIT ('EMPDISP');
         00017    DCL  EMPDISP2      CHAR (8) INIT ('EMPDISP2');
         00018    DCL  DC_AID_IND_V    CHAR (1);
         00019       /* LOGICAL CONSTANTS */
         00020    DCL  YES         BIT(1)  INIT ('1'B);
         00021    DCL  NO         BIT(1)  INIT ('0'B);
         00022    DCL  1 PROGRAM_MESSAGES,
         00023         3 DISPLAY_MSG   CHAR (36)
         00024          INIT (' EMPLOYEE INFORMATION DISPLAYED '),
         00025         3 NOT_FOUND_MSG    CHAR (37)
         00026          INIT (' SPECIFIED EMPLOYEE NUMBER NOT FOUND ');
         00027
DMLP     00029    INCLUDE IDMS (SUBSCHEMA_CTRL);
         00100
DMLP     00102    INCLUDE IDMS (EMPLOYEE);
DMLP     00133    INCLUDE IDMS (MAP_CONTROLS);
         00171
         00172    /*    PROCESSING FOLLOWS             */
         00173
         00174    MAIN_LINE: BEGIN;
         00175                    /* ESTABLISH ADDRESSABILITY FOR */
DMLP0001 00177         BIND MAP (EMPLMAP);
         00208         CALL IDMS_STATUS;
DMLP0002 00210         BIND MAP (EMPLMAP) RECORD (EMPLOYEE);
         00219         CALL IDMS_STATUS;
         00220                     /* DETERMINE THE TASK CODE */
DMLP0003 00222         ACCEPT TASK CODE INTO (TASK_CODE);
         00231         CALL IDMS_STATUS;
         00232
         00233         IF TASK_CODE = EMPDISP
         00234         THEN CALL FIRST_TIME;
         00235         IF TASK_CODE = EMPDISP2
         00236         THEN CALL SECOND_TIME;
         00237
         00238
         00239
         00240                 /* OTHERWISE RETURN TO IDMS-DC */
DMLP0004 00242         DC RETURN;
         00249
         00250    FIRST_TIME: PROC;
DMLP0005 00252     MODIFY MAP (EMPLMAP)
         00253      FOR ALL BUT DFLD (EMP_ID_0415)
         00254      ATTRIBUTES PROTECTED;
         00267
DMLP0006 00269     MAP OUT(EMPLMAP)
         00270      IO OUTPUT DATA YES NEWPAGE;
         00284     CALL IDMS_STATUS;
DMLP0007 00286     DC RETURN NEXT TASK CODE(EMPDISP2);
         00295    END FIRST_TIME;
         00296
         00297    SECOND_TIME: PROC;
DMLP0008 00299     MAP IN (EMPLMAP)
         00300       IO INPUT DATA YES;
         00314     CALL IDMS_STATUS;
         00315                    /* CHECK WHICH PF KEY WAS PRESSED */
DMLP0009 00317     INQUIRE MAP(EMPLMAP)
         00318       MOVE AID TO (DC_AID_IND_V);
         00328
         00329                    /* STOP IF PA1 (%) WAS PRESSED */
         00330     IF DC_AID_IND_V = '%'
DMLP0010 00331       THEN
         00333          DC RETURN;
         00340
DMLP0011 00342     BIND RUN_UNIT;
         00351     CALL IDMS_STATUS;
DMLP0012 00353     BIND RECORD (EMPLOYEE);
         00362     CALL IDMS_STATUS;
DMLP0013 00364     READY AREA (EMP_DEMO_REGION);
         00372     CALL IDMS_STATUS;
         00373                   /* OBTAIN THE RECORD */
DMLP0014 00375     OBTAIN CALC RECORD (EMPLOYEE);
         00384     IF ERROR_STATUS = '0326' THEN CALL NO_EMP;
         00385     CALL IDMS_STATUS;
DMLP0015 00387     FINISH;
         00394     CALL IDMS_STATUS;
         00395               /* TRANSMIT THE DATA BACK TO THE SCREEN */
DMLP0016 00397     MAP OUT(EMPLMAP)
         00398       IO OUTPUT DATA YES NEWPAGE
         00399       MESSAGE(DISPLAY_MSG) LENGTH(36);
         00415     CALL IDMS_STATUS;
DMLP0017 00417     DC RETURN NEXT TASK CODE(EMPDISP2);
         00426
         00427    END SECOND_TIME;
         00428
         00429    NO_EMP: PROC;
         00430               /* DO THIS IF EMPLOYEE NOT FOUND */
DMLP0018 00432     MAP OUT(EMPLMAP)
         00433      IO OUTPUT DATA YES NEWPAGE
         00434      MESSAGE(NOT_FOUND_MSG) LENGTH(37);
         00450     CALL IDMS_STATUS;
DMLP0019 00452     DC RETURN NEXT TASK CODE(EMPDISP2);
         00461    END NO_EMP;
         00462
DMLP     00464         INCLUDE IDMS (IDMS_STATUS);
         00465   IDMS_STATUS: PROC;
         00466   /* THE IDMS_STATUS PROCEDURE MAY BE CALLED BY THE USER AFTER */
         00467   /* EACH IDMS COMMAND HAS BEEN ISSUED AND CHECKS HAVE BEEN  */
         00468   /* MADE FOR ANY EXPECTED NON_ZERO ERROR STATUS CONDITIONS.  */
         00469   /* IT DETECTS A NON_ZERO ERROR_STATUS AND TERMINATES THE   */
         00470   /* PROGRAM WITH A SNAP OF THE SUBSCHEMA_CTRL AREA AND AN   */
         00471   /* ABEND WITH THE ERROR_STATUS AS THE ABEND CODE.      */
         00472     IF ERROR_STATUS='0000' THEN GOTO END_STATUS;
         00473     SSC_ERRSTAT_SAVE=ERROR_STATUS; /* SAVE THE ERROR_STATUS */
         00474     SSC_DMLSEQ_SAVE=DML_SEQUENCE; /* SAVE DML_SEQUENCE   */
         00475   /* SNAP THE SUBSCHEMA_CTRL AREA */
DMLP0020 00477     SNAP FROM (SUBSCHEMA_CTRL) TO (SUBSCHEMA_CTRL_END);
         00490   /* ABEND */
DMLP0021 00492     ABEND CODE (SSC_ERRSTAT_SAVE);
         00501    END_STATUS: END;
         00502    END MAIN_LINE; /* END MAIN_LINE */
         00503    END EMPDISP;