00001  IDENTIFICATION DIVISION.                                         01/04/10
00002  PROGRAM-ID.             DTSCU826.                                DTSCU826
00003  AUTHOR.                 NGC.                                        LV001
00004  DATE-WRITTEN.           DECEMBER 2009.                           DTSCU826
00005  DATE-COMPILED.                                                   DTSCU826
00006      SKIP3                                                        DTSCU826
00007 *****                                                             DTSCU826
00008 *                                                                 DTSCU826
00009 *    FUNCTION:  ACCOUNTING HISTORY FILE OUTPUT                    DTSCU826
00010 *                                                                 DTSCU826
00011 *                                                                 DTSCU826
00012 *    MODIFICATION LOG:                                            DTSCU826
00013 *                                                                 DTSCU826
00014 *    13/14/2009  INITIAL DEVELOPMENT.                             DTSCU826
00015 *                WORK ORDER:                    PROGRAMMER: GD    DTSCU826
00016 *                                                                 DTSCU826
00017 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU826
00018 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU826
00019 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSCU826
00020 *                                                                 DTSCU826
00021 *                                                                 DTSCU826
00022 *    DESCRIPTION:                                                 DTSCU826
00023 *                                                                 DTSCU826
00024 *        DTSCU826 WRITES VARIABLE LENGTH RECORDS TO THE           DTSCU826
00025 *        ACCOUNTING HSITORY FILE.  THE COMMAREA CONSISTS OF       DTSCU826
00026 *        DTSIL826, FOLLOWED BY DTSIAATH. SEE DFHCOMMAREA          DTSCU826
00027 *        OF THIS MODULE FOR AN EXAMPLE.                           DTSCU826
00028 *                                                                 DTSCU826
00029 *                                                                 DTSCU826
00030 *    GENERAL SPECIFICATIONS:                                      DTSCU826
00031 *                                                                 DTSCU826
00032 *        IF AN INVALID COMMAND IS REQUESTED, THEN ABEND THE       DTSCU826
00033 *        MODULE.                                                  DTSCU826
00034 *                                                                 DTSCU826
00035 *        IF THE WRITE COMMAND YIELDS A RESPONSE OTHER THAN        DTSCU826
00036 *        NORMAL, NOTOPEN, OR DISABLED, THEN ABEND THE MODULE.     DTSCU826
00037 *                                                                 DTSCU826
00038 *        AATH-REC IS THE RECORD TO BE WRITTEN.                    DTSCU826
00039 *                                                                 DTSCU826
00040 *        DTS*ATH IS A VSAM ESDS. A VSAM ESDS WRITE COMMAND        DTSCU826
00041 *        RETURNS THE RELATIVE BYTE ADDRESS (RBA) OF THE RECORD    DTSCU826
00042 *        IN RIDFLD.  SPECIFY RIDFLD (WRK-RBA).                    DTSCU826
00043 *                                                                 DTSCU826
00044 *                                                                 DTSCU826
00045 *****                                                             DTSCU826
00046      SKIP3                                                        DTSCU826
00047  ENVIRONMENT DIVISION.                                            DTSCU826
00048      SKIP3                                                        DTSCU826
00049  DATA DIVISION.                                                   DTSCU826
00050      SKIP3                                                        DTSCU826
00051  WORKING-STORAGE SECTION.                                         DTSCU826
000515 77  PAN-VALET PICTURE X(24) VALUE '001DTSCU826  01/04/10'.       DTSCU826
00052      SKIP3                                                        DTSCU826
00053  01  WRK-AREA.                                                    DTSCU826
00054      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'U826'.    DTSCU826
00055      05  WRK-RESP-CD                 PIC S9(08)  COMP.            DTSCU826
00056      05  WRK-REC-LENGTH              PIC S9(04)  COMP VALUE +256. DTSCU826
00057                                                                   DTSCU826
00058      05  WRK-PROD-FILE-NAME          PIC  X(08)  VALUE 'DTSFATH'. DTSCU826
00059                                                                   DTSCU826
00060      05  EMSG-NOT-AVAILABLE.                                      DTSCU826
00061          10  FILLER                  PIC  X(04)  VALUE 'E091'.    DTSCU826
00062          10  FILLER                  PIC  X(06)  VALUE 'FILE  '.  DTSCU826
00063          10  EMSG-FILE-NAME          PIC  X(08).                  DTSCU826
00064          10  FILLER                  PIC  X(33)                   DTSCU826
00065        VALUE '  NOT AVAILABLE  PLEASE TRY LATER'.                 DTSCU826
00066      05  WRK-FILE-NAME               PIC  X(08).                  DTSCU826
00067                                                                   DTSCU826
00068      05  WRK-RBA                     PIC S9(08)  COMP.            DTSCU826
00069      EJECT                                                        DTSCU826
00070  01  L005-COMM-AREA.                                              DTSCU826
00071  ++INCLUDE DTSIL005                                               DTSCU826
00072                                                                   DTSCU826
00073  LINKAGE SECTION.                                                 DTSCU826
00074      SKIP3                                                        DTSCU826
00075  01  DFHCOMMAREA.                                                 DTSCU826
00076      05  L826-CONTROL-BLOCK.                                      DTSCU826
00077  ++INCLUDE DTSIL826                                               DTSCU826
00078      SKIP3                                                        DTSCU826
00079      05  ATH-REC.                                                 DTSCU826
00080  ++INCLUDE DTSIAATH                                               DTSCU826
00081      EJECT                                                        DTSCU826
00082  PROCEDURE DIVISION.                                              DTSCU826
00083                                                                   DTSCU826
00084      SET L005-FROM-SYS       TO TRUE.                             DTSCU826
00085      PERFORM S005-CDATE-TIME THRU S005-EXIT.                      DTSCU826
00086                                                                   DTSCU826
00087      MOVE WRK-PROD-FILE-NAME TO WRK-FILE-NAME.                    DTSCU826
00088                                                                   DTSCU826
00089      MOVE SPACES TO L826-MSG-AREA.                                DTSCU826
00090                                                                   DTSCU826
00091      SET L826-OK-88 TO TRUE.                                      DTSCU826
00092                                                                   DTSCU826
00093      PERFORM P3100-WRITE THRU P3100-EXIT.                         DTSCU826
00094                                                                   DTSCU826
00095 **   IF L826-WRITE-88                                             DTSCU826
00096 *        PERFORM P3100-WRITE THRU P3100-EXIT                      DTSCU826
00097 *    ELSE                                                         DTSCU826
00098 **       PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU826
00099                                                                   DTSCU826
00100                                                                   DTSCU826
00101      EXEC CICS                                                    DTSCU826
00102          RETURN                                                   DTSCU826
00103      END-EXEC.                                                    DTSCU826
00104                                                                   DTSCU826
00105                                                                   DTSCU826
00106                                                                   DTSCU826
00107      GOBACK.                                                      DTSCU826
00108      EJECT                                                        DTSCU826
00109  P3100-WRITE.                                                     DTSCU826
00110      MOVE L005-DATE           TO AATH-DATE.                       DTSCU826
00111      MOVE L005-TIME           TO AATH-TIME.                       DTSCU826
00112                                                                   DTSCU826
00113      EXEC CICS                                                    DTSCU826
00114          WRITE                                                    DTSCU826
00115              DATASET (WRK-FILE-NAME)                              DTSCU826
00116              FROM (ATH-REC)                                       DTSCU826
00117              LENGTH (WRK-REC-LENGTH)                              DTSCU826
00118              RIDFLD (WRK-RBA)                                     DTSCU826
00119              RBA                                                  DTSCU826
00120              RESP (WRK-RESP-CD)                                   DTSCU826
00121      END-EXEC.                                                    DTSCU826
00122                                                                   DTSCU826
00123      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU826
00124                         OR DFHRESP (SYSIDERR)                     DTSCU826
00125          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU826
00126          GO TO P3100-EXIT.                                        DTSCU826
00127                                                                   DTSCU826
00128      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU826
00129          NEXT SENTENCE                                            DTSCU826
00130      ELSE                                                         DTSCU826
00131          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU826
00132  P3100-EXIT.                                                      DTSCU826
00133      EXIT.                                                        DTSCU826
00134                                                                   DTSCU826
00135  S1100-NOT-AVAILABLE.                                             DTSCU826
00136      MOVE WRK-FILE-NAME TO EMSG-FILE-NAME.                        DTSCU826
00137                                                                   DTSCU826
00138      MOVE EMSG-NOT-AVAILABLE TO L826-MSG-AREA.                    DTSCU826
00139                                                                   DTSCU826
00140      SET L826-FILE-CLOSED-88 TO TRUE.                             DTSCU826
00141  S1100-EXIT.                                                      DTSCU826
00142      EXIT.                                                        DTSCU826
00143                                                                   DTSCU826
00144  S005-CDATE-TIME.                                                 DTSCU826
00145      EXEC CICS LINK                                               DTSCU826
00146          PROGRAM  ('DTSCU005')                                    DTSCU826
00147          COMMAREA (L005-COMM-AREA)                                DTSCU826
00148      END-EXEC.                                                    DTSCU826
00149  S005-EXIT.                                                       DTSCU826
00150      EXIT.                                                        DTSCU826
00151                                                                   DTSCU826
00152  S899-ABEND.                                                      DTSCU826
00153                                                                   DTSCU826
00154      EXEC CICS                                                    DTSCU826
00155          ABEND                                                    DTSCU826
00156              ABCODE (WRK-ABEND-CD)                                DTSCU826
00157      END-EXEC.                                                    DTSCU826
00158                                                                   DTSCU826
00159  S899-EXIT.                                                       DTSCU826
00160      EXIT.                                                        DTSCU826
