home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / viscobv6.zip / vac22os2 / ibmcobol / samples / putut / init1prg.cbl < prev    next >
Text File  |  1996-07-18  |  6KB  |  70 lines
  1.       PROCESS LIB                                                       INI00010
  2.       *************************************************************     INI00020
  3.       *                                                           *     INI00030
  4.       *    Licensed Material - Property of IBM                    *     INI00040
  5.       *                                                           *     INI00050
  6.       *    83H9095 (C) Copyright IBM Corp., 1996                  *     INI00060
  7.       *    All rights reserved                                    *     INI00070
  8.       *                                                           *     INI00080
  9.       *    US Government Users Restricted Rights - Use,           *     INI00090
  10.       *    duplication or disclosure restricted by GSA ADP        *     INI00100
  11.       *    Schedule Contract with IBM Corp.                       *     INI00110
  12.       *                                                           *     INI00120
  13.       *************************************************************     INI00130
  14.       * File INIT1PRG COBOL                                             INI00140
  15.        IDENTIFICATION DIVISION.                                         INI00150
  16.          PROGRAM-ID.    INIT1PRG.                                       INI00160
  17.        ENVIRONMENT DIVISION.                                            INI00170
  18.        DATA DIVISION.                                                   INI00180
  19.        WORKING-STORAGE SECTION.                                         INI00190
  20.          COPY RECIN.                                                    INI00200
  21.                                                                         INI00210
  22.          01 BAD-CODE-1 REDEFINES INBUFVARDS.                            INI00220
  23.              05  Z                            PIC X(160).               INI00230
  24.              05  NEW-NAME                     PIC X(12).                INI00240
  25.       * NEW_NAME is both date fields combined                           INI00250
  26.                                                                         INI00260
  27.          01 BAD-CODE-2.                                                 INI00270
  28.             05 NEW-NAME                       PIC X(12).                INI00280
  29.             05 BAD-NAME REDEFINES NEW-NAME.                             INI00290
  30.                07 A                           PIC X(5).                 INI00300
  31.                07 B                           PIC X(1).                 INI00310
  32.                07 D                           PIC X(2).                 INI00320
  33.                07 M                           PIC X(2).                 INI00330
  34.                07 Y                           PIC X(2).                 INI00340
  35.                                                                         INI00350
  36.        LINKAGE SECTION.                                                 INI00360
  37.          COPY COMNDATA.                                                 INI00370
  38.          COPY RECOUT.                                                   INI00380
  39.          01 BAD-CODE-3 REDEFINES OUTBUFVARDS.                           INI00390
  40.              05  C                            PIC X(180).               INI00400
  41.              05  D                            PIC X(2).                 INI00410
  42.              05  M                            PIC X(2).                 INI00420
  43.              05  Y                            PIC X(2).                 INI00430
  44.       * D M Y is ACCOUNT-UPDT-DDMMYY                                    INI00440
  45.                                                                         INI00450
  46.        PROCEDURE DIVISION USING OUTBUFVARDS, COMNDATA.                  INI00460
  47.                                                                         INI00470
  48.                  MOVE '123199' TO RUNDATE.                              INI00480
  49.                                                                         INI00490
  50.                  CALL 'INIT2PRG'.                                       INI00500
  51.                                                                         INI00510
  52.                  PERFORM 1000-SET-COSTVAR                               INI00520
  53.                     THRU 1000-SC-EXIT.                                  INI00530
  54.                                                                         INI00540
  55.       * set output record update date field in unobvious way            INI00550
  56.                  MOVE CORRESPONDING BAD-CODE-1 TO BAD-CODE-2.           INI00560
  57.                  MOVE CORRESPONDING BAD-NAME TO BAD-CODE-3.             INI00570
  58.                                                                         INI00580
  59.                  DISPLAY 'INIT1PRG ENDS' ACCOUNT-UPDT-DDMMYY            INI00590
  60.                                          OF OUTBUFVARDS.                INI00600
  61.                  GOBACK.                                                INI00610
  62.                                                                         INI00620
  63.        1000-SET-COSTVAR.                                                INI00630
  64.                                                                         INI00640
  65.                  MOVE 2 TO COSTVAR.                                     INI00650
  66.                  MOVE RUNDATE TO ACCOUNT-UPDT-DDMMYY OF INBUFVARDS.     INI00660
  67.                                                                         INI00670
  68.        1000-SC-EXIT.                                                    INI00680
  69.             EXIT.                                                       INI00690
  70.