PL/I: API mode, DB2 with QUICKSAM CALLs

/*    QuickStart demo program (PL/I)   */
  /*             uses PL/I and DB2       */

QSPLI:    PROC OPTIONS( MAIN ) REORDER;

DCL PLIXOPT      CHAR (50) VARYING EXTERNAL
                   INIT('NOSPIE,NOSTAE');
DCL SYSPRINT    FILE STREAM OUTPUT PRINT;
DCL ABEND       ENTRY;
DCL QUICKSAM    ENTRY OPTIONS( ASSEMBLER INTER );
DCL BTCHCKPT    ENTRY OPTIONS( ASSEMBLER INTER );
DCL QSJOB       ENTRY OPTIONS( ASSEMBLER INTER );
/* The following is the "Checkpoint Area", to be Checkpointed
by QuickStart
*/
DCL 1 CKPT_SAVE_AREA,
      2 CKPT_ROUTINE_DATA,
        3 CKPT_RECORD_KEY,
          4 CKPT_PGM_NAME         CHAR (08) INIT('QWIKDEMO'),
          4 CKPT_JOB_NAME         CHAR (08) INIT('JOBNAME '),
          4 CKPT_PGM_NBR          CHAR (04) INIT(' '),
        3 CKPT_RECORD_DATA,
          4 CKPT_FREQUENCY        CHAR (04) INIT('0001'),
          4 CKPT_INTERNAL         CHAR (56) INIT(' '),
        3 CKPT_REQUEST_TYPE       CHAR (01) INIT('S'),
        3 CKPT_RETURN_CODE        CHAR (01) INIT(' '),
        3 CKPT_TAKEN_FLAG         CHAR (01) INIT('N'),
        3 FILLER                  CHAR (41) INIT(' '),
      2 NBR_OF_SAMS               FIXED BINARY (15) INIT(2),
      2 FILLER                    CHAR (02) INIT(' '),
      2 SAM1_DEFINITION,
        3 SAM1_DDNAME             CHAR (08) INIT('INFILEA '),
        3 SAM1_REQUEST_TYPE       CHAR (06) INIT('OPEN '),
        3 SAM1_FILE_TYPE          CHAR (01) INIT('I'),
        3 SAM1_RETURN_CODE        CHAR (03) INIT(' '),
        3 FILLER                  CHAR (57) INIT(' '),
        3 SAM1_VSAM-RECFM         CHAR (01) INIT(' '),
        3 FILLER                  CHAR (04) INIT(' '),
     2 RECORDS_COPIED          PIC '(9)9' INIT(0),
     2 SAM2_DEFINITION,
       3 SAM2_DDNAME              CHAR (08) INIT('OUTFILED'),
       3 SAM2_REQUEST_TYPE        CHAR (06) INIT('OPEN '),
       3 SAM2_FILE_TYPE           CHAR (01) INIT('O'),
       3 SAM2_RETURN_CODE         CHAR (03) INIT(' '),
       3 FILLER                   CHAR (57) INIT(' '),
       3 SAM2_VSAM-RECFM          CHAR (01) INIT(' '),
       3 FILLER                   CHAR (04) INIT(' '),
/* Other fields which need to appear in the "Checkpoint Area"
      should be placed here.
   Fields appearing after "ckpt_area_end" are not included
            in the "Checkpoint Area".
*/
      2 DBMS_KEY_VALUE_1 CHAR (20),
      2 DBMS_KEY_VALUE_2 CHAR (10),

      2 OTHER_SAVE_AREA_DATA CHAR (30)
              INIT('ABCABCABCABCABCABCABCABCAB'),

/* The following marks the end of the W/S "Checkpoint Area"
*/
      2 CKPT_AREA_END             CHAR (20)
              INIT('** CKPT AREA END **');
/* Fields appearing beyond this point are not included in
     the W/S "Checkpoint Area" and are not restored during a
    "Restart".
*/
DCL NOT_SAVE_AREA_DATA           CHAR (30)
               INIT('ABCABCABCABCABCABCABCABCAB');
DCL TIME_FOR_CKPT_COUNT         PIC 'S(5)9' INIT(0);
DCL REC_IO_AREA                 CHAR (1500);
DCL WK_CODE                     PIC '999';
DCL CKPT_RECORD_KEY_AREA        CHAR (20)
BASED( ADDR( CKPT_SAVE_AREA.CKPT_RECORD_KEY ) );
DCL SAM1_WORK_AREA              CHAR (80)
BASED( ADDR( CKPT_SAVE_AREA.SAM1_DEFINITION ) );
DCL SAM2_WORK_AREA             CHAR (80)
BASED( ADDR( CKPT_SAVE_AREA.SAM2_DEFINITION ) );

/* DB2 SQLCA is included into the program by the
    DB2 pre-compiler
*/
EXEC SQL INCLUDE SQLCA;

/* PL/I built-in functions
*/
DCL ADDR      BUILTIN;
DCL LOW       BUILTIN;
DCL NULL      BUILTIN;
DCL PLIDUMP   BUILTIN;

/* "main line" of code
*/
MAINLINE_CODE:

/* On-Error block to issue an ABEND U(3500) and dump
      PL/I and program storage areas
*/
ON ERROR SNAP
  BEGIN;
    ON ERROR CALL ABEND( 3599 );
    CALL PLIDUMP( 'TBFCAH' );
    CLOSE FILE( SYSPRINT );
    CALL ABEND( 3500 );
   END; /* BEGIN */
   FETCH QUICKSAM;
   FETCH BTCHCKPT;
   FETCH QSJOB;

/* SQL "whenever" clauses to route control following
    unexpected conditions
 */
  EXEC SQL WHENEVER NOT FOUND CONTINUE;
  EXEC SQL WHENEVER SQLWARNING CONTINUE;
  EXEC SQL WHENEVER SQLERROR GOTO DBMS_ERROR_ROUTINE;

  DISPLAY('Q U I C K S T A R T D E M O ');
  DISPLAY('_______________________________ ');
  DISPLAY(' ');
  DISPLAY(' ');
  DISPLAY(' ');
  DISPLAY(' QUICKSTART MONITORED OTHERDATA = ' ||
        OTHER_SAVE_AREA_DATA);
   DISPLAY(' QUICKSTART NOT_SAVED DATA     = ' ||
        NOT_SAVE_AREA_DATA);
/* Initialize QuickStart
*/

CALL CKPT_RTN;

/* Check for a "Restart" condition.
   No need to initialize, since QuickStart replaces
     the W/S Checkpoint Area
*/
   IF CKPT_SAVE_AREA.CKPT_RETURN_CODE = 'R'
   THEN
      DO;
         DISPLAY('RESTART IN PROGRESS FROM RECORD '   ||
            RECORDS_COPIED);
         DISPLAY(' QUICKSTART MONITORED OTHERDATA = ' ||
            OTHER_SAVE_AREA_DATA);
         DISPLAY(' QUICKSTART NOT_SAVED DATA      = ' ||
             NOT_SAVE_AREA_DATA);
   END; /* Then Do */
/* Assume normal "Start".
   Perform normal initializations
*/
    ELSE
       DO;
         OTHER_SAVE_AREA_DATA   = 'XYZXYZXYZXYZXYZXYZXYZ';
         NOT_SAVE_AREA_DATA     = 'XYZXYZXYZXYZXYZXYZXYZ';
      END; /* Else Do */

/* Initialize "ckpt_request_type" to blank ("normal" mode).
   Initialize QuickSam fields to indicate file operation
    request types
*/
   CKPT_REQUEST_TYPE = ' ';
    SAM1_REQUEST_TYPE = 'READ ';
    SAM2_REQUEST_TYPE = 'WRITE';

/* Main program loop
*/
  DO UNTIL(SAM1_RETURN_CODE = 'EOF');

/* Read a record (through QuickSam.)
   If at "end-of-file", exit
*/
    CALL QUICKSAM
        ( SAM1_WORK_AREA, REC_IO_AREA );

   IF SAM1_RETURN_CODE  = 'EOF'
      THEN LEAVE;

/* Write a record (through QuickSam.)
   Update a record counter.
*/
       CALL QUICKSAM
          ( SAM2_WORK_AREA, REC_IO_AREA );

     RECORDS_COPIED      = RECORDS_COPIED + 1;
/* Update Checkpoint-timing fields
*/
      TIME_FOR_CKPT_COUNT = TIME_FOR_CKPT_COUNT + 1;

/* Determine if conditions are correct to issue a Checkpoint
       (using the value "200" as an arbitrary factor.)
*/
    IF TIME_FOR_CKPT_COUNT >= 200
       THEN
          DO;
           CKPT_REQUEST_TYPE = ' ';

      CALL CKPT_RTN;

      TIME_FOR_CKPT_COUNT = 0;
/* Determine whether or not a Checkpoint was actually issued.
      If yes, perform any post-Checkpointing activity,
        as necessary.
*/

        IF CKPT_SAVE_AREA.CKPT_TAKEN_FLAG = 'Y'
            THEN
               DISPLAY('CHECKPOINT AFTER ' ||
                            RECORDS_COPIED ||
                           ' RECORDS.');
               END; /* Then Do */

       END; /* DO UNTIL */

/* Perform normal end-of-program functions.
Inform QuickStart of the "normal" completion status
*/
CLEAN_UP:
     CKPT_REQUEST_TYPE = 'E';

     CALL CKPT_RTN;

DISPLAY('PROGRAM TERMINATING AFTER ' || RECORDS_COPIED
              || ' RECORDS.');
   CLOSE FILE(SYSPRINT);

   GOTO END_OF_PROGRAM;

/* logical end of program */

/* Common DB2 error handler,
    Display diagnostics,
    Proceed to the end-of-program
*/
DBMS_ERROR_ROUTINE:
   WK_CODE = SQLCODE;

 IF SQLCODE < 0
   THEN
      DISPLAY('SQLCODE =' || WK_CODE || '(MINUS)' );
    ELSE

DISPLAY('SQLCODE =' || WK_CODE);
   DISPLAY('ERRPGM =' || SQLERRP);
   DISPLAY('ERRMSG =' || SQLERRM);
   DISPLAY('SQLERR1 =' || SQLERRD(1));
   DISPLAY('SQLERR2 =' || SQLERRD(2));
   DISPLAY('SQLERR3 =' || SQLERRD(3));
   DISPLAY('SQLERR4 =' || SQLERRD(4));
   DISPLAY('SQLERR5 =' || SQLERRD(5));
   DISPLAY('SQLERR6 =' || SQLERRD(6));
   DISPLAY('SQLWARN0=' || SQLWARN0);
   DISPLAY('SQLWARN1=' || SQLWARN1);
   DISPLAY('SQLWARN2=' || SQLWARN2);
   DISPLAY('SQLWARN3=' || SQLWARN3);
   DISPLAY('SQLWARN4=' || SQLWARN4);
   DISPLAY('SQLWARN5=' || SQLWARN5);
   DISPLAY('SQLWARN6=' || SQLWARN6);
   DISPLAY('SQLWARN7=' || SQLWARN7);

GOTO CLEAN_UP;
/* The QuickStart interface routine, "CKPT_RTN",
      application code is provided by the vendor,
      then modified on-site
*/
CKPT_RTN: PROCEDURE REORDER;

    IF CKPT_REQUEST_TYPE = 'S'
     THEN
        DO;

/* If the "jobname" field has not yet been properly initialized,
       retrieve the jobname and store it in the program W/S
*/

        IF CKPT_JOB_NAME = 'JOBNAME '
           THEN
              CALL QSJOB( CKPT_JOB_NAME );

/* Retrieve Checkpoint frequency and control parameters
     from the QuickStart Checkpoint Control Table
    (a DB2 table)
*/

       EXEC SQL
            SELECT
               CKPTCNTL_FREQ,
               CKPTCNTL_INTERNAL
            INTO
               :CKPT_FREQUENCY,
               :CKPT_INTERNAL
            FROM
               CKPTCNTL_TABLE
            WHERE
               CKPTCNTL_KEY = :CKPT_RECORD_KEY_AREA;
/* If there was no record for this program,
       create one, using program-provided default values
*/

          IF SQLCODE NOT = 0
               THEN
                 DO;
 EXEC SQL
                 INSERT
                   INTO
                      CKPTCNTL_TABLE
                      (CKPTCNTL_KEY,
                       CKPTCNTL_FREQ,
                       CKPTCNTL_INTERNAL)
                   VALUES
                      (:CKPT_RECORD_KEY_AREA,
                       :CKPT_FREQUENCY,
                       :CKPT_INTERNAL);
/* If the SQLCODE is still non-zero,
    assume there must be a serious DB2 problem
*/

           IF SQLCODE NOT = 0
                  THEN
                     DO;
                     DISPLAY('ISRT FAILED');
                     DISPLAY('SQLCODE = ' || SQLCODE);
                     SIGNAL ERROR;
             END; /* Then Do */
      END; /* Then Do */
   END; /* IF CKPT_REQUEST_TYPE = 'S' */

/* If processing a Start-Up request
*/
    IF CKPT_REQUEST_TYPE NOT = 'S'
        THEN
          DO;
EXEC SQL
           SELECT
               CKPTCNTL_FREQ
           INTO
             :CKPT_FREQUENCY
           FROM
              CKPTCNTL_TABLE
           WHERE
              CKPTCNTL_KEY = :CKPT_RECORD_KEY_AREA;

  IF SQLCODE NOT = 0
     THEN
       DO;
          DISPLAY('READ FAILED TO CKPT CNTL RECORD');
          DISPLAY('SQLCODE = ' || SQLCODE);
          SIGNAL ERROR;
         END; /* Then Do */
     END; /* IF CKPT_REQUEST_TYPE NOT = 'S' */
 /* Call BTCHCKPT to manage all Checkpointing matters
*/

   CALL BTCHCKPT
      ( CKPT_SAVE_AREA, CKPT_AREA_END );

/* Determine whether or not BTCHCKPT has actually issued a Checkpoint
*/
   IF CKPT_SAVE_AREA.CKPT_TAKEN_FLAG = 'Y'
      THEN
         IF CKPT_REQUEST_TYPE = 'E'
      THEN
        CKPT_INTERNAL = ' ';

/* If a Checkpoint was issued,
     update the DB2-based QuickStart Checkpoint Control Table
*/

   IF CKPT_SAVE_AREA.CKPT_TAKEN_FLAG = 'Y'
         THEN
            DO;
EXEC SQL
             UPDATE
                  CKPTCNTL_TABLE
               SET
                 CKPTCNTL_FREQ = :CKPT_FREQUENCY,
                 CKPTCNTL_INTERNAL = :CKPT_INTERNAL
              WHERE
                 CKPTCNTL_KEY = :CKPT_RECORD_KEY_AREA;
/* If the SQL "UPDATE" was ineffective,
    manage error condition
  Else
    "COMMIT" all activity
*/

    IF SQLCODE NOT = 0
       THEN
         DO;
           DISPLAY('UPDATE FAILED');
           DISPLAY('SQLCODE = ' || SQLCODE);
           SIGNAL ERROR;
         END; /* Then Do */
      ELSE
          DO;
            EXEC SQL COMMIT;

IF SQLCODE NOT = 0
                        THEN
                            DO;
                             DISPLAY('COMMIT FAILED');
                             DISPLAY('SQLCODE = ' || SQLCODE);
                             SIGNAL ERROR;
                      END; /* Then Do */
                END; /* Else Do */
            END;
     END; /* CKPT_RTN PROC */
END_OF_PROGRAM:
    END; /* QSPLI PROC */