00001  IDENTIFICATION DIVISION.                                         10/14/98
00002  PROGRAM-ID.             DTSBU005.                                DTSBU005
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV007
00004  DATE-WRITTEN.           JULY 1994.                               DTSBU005
00005  DATE-COMPILED.                                                   DTSBU005
00006      SKIP3                                                        DTSBU005
00007 *****                                                             DTSBU005
00008 *                                                                 DTSBU005
00009 *    FUNCTION:   ABSOLUTE TIME EDIT/CONVERSION MODULE.            DTSBU005
00010 *                                                                 DTSBU005
00011 *                                                                 DTSBU005
00012 *    MODIFICATION LOG:                                            DTSBU005
00013 *                                                                 DTSBU005
00014 *    08/04/98  CLONED FROM MACBU005.                                 CL**2
00015 *              WORK ORDER:                      PROGRAMMER: ZL1.     CL**2
00016 *                                                                 DTSBU005
00017 *    09/29/1998  ADDED L005-SLASH-8-DATE RELATED CODE.               CL**5
00018 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH      CL**5
00019 *                                                                    CL**5
00020 *    10/14/1998  ADDED L005-DATE-8-SLASH-TIME CODE.                  CL**6
00021 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH      CL**6
00022 *                                                                    CL**6
00023 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**5
00024 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**5
00025 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX      CL**5
00026 *                                                                 DTSBU005
00027 *                                                                 DTSBU005
00028 *    DESCRIPTION:                                                 DTSBU005
00029 *                                                                 DTSBU005
00030 *****                                                             DTSBU005
00031      SKIP3                                                        DTSBU005
00032  ENVIRONMENT DIVISION.                                            DTSBU005
00033      SKIP3                                                        DTSBU005
00034  DATA DIVISION.                                                   DTSBU005
00035      SKIP3                                                        DTSBU005
00036  WORKING-STORAGE SECTION.                                         DTSBU005
000365 77  PAN-VALET PICTURE X(24) VALUE '007DTSBU005  10/14/98'.       DTSBU005
00037      SKIP3                                                        DTSBU005
00038  01  WRK-AREA.                                                    DTSBU005
00039      05  WRK-ABEND-CD            PIC S9(04) COMP   VALUE +005.    DTSBU005
00040                                                                      CL**5
00041      05  MSEC-PER-HOUR                    PIC S9(15)  COMP-3      DTSBU005
00042                                               VALUE  +3600000.    DTSBU005
00043      05  MSEC-PER-MINUTE                  PIC S9(15)  COMP-3      DTSBU005
00044                                               VALUE    +60000.    DTSBU005
00045      05  MSEC-PER-SECOND                  PIC S9(15)  COMP-3      DTSBU005
00046                                               VALUE     +1000.    DTSBU005
00047      05  MSEC-PER-DAY                     PIC S9(15)  COMP-3      DTSBU005
00048                                              VALUE  +86400000.    DTSBU005
00049      05  ABS-DAYS-FROM-01011900           PIC S9(08)  COMP.       DTSBU005
00050      05  JAN011930-ABS-DAY                PIC S9(08)  COMP.       DTSBU005
00051      05  FIRST-30-YEARS                   PIC S9(08)  COMP        DTSBU005
00052                                              VALUE     +10957.    DTSBU005
00053      05  WRK-JUL-ABS-DAY                  PIC S9(08)  COMP.       DTSBU005
00054                                                                      CL**5
00055      05  WS-DATE-FORMAT                   PIC  9(06).             DTSBU005
00056      05  FILLER REDEFINES WS-DATE-FORMAT.                         DTSBU005
00057          10  WS-DATE-MO                   PIC  9(02).             DTSBU005
00058          10  WS-DATE-DAY                  PIC  9(02).             DTSBU005
00059          10  WS-DATE-YEAR                 PIC  9(02).             DTSBU005
00060                                                                      CL**5
00061      05  WRK-8-TIME                       PIC  9(08).             DTSBU005
00062      05  FILLER REDEFINES WRK-8-TIME.                             DTSBU005
00063          10  WRK-8-HOUR-MIN-SEC           PIC  9(06).             DTSBU005
00064          10  WRK-8-HUND                   PIC  9(02).             DTSBU005
00065                                                                      CL**5
00066      05  WRK-6-TIME                       PIC  9(06).             DTSBU005
00067      05  FILLER REDEFINES WRK-6-TIME.                             DTSBU005
00068          10  WRK-6-HOUR                   PIC  9(02).             DTSBU005
00069          10  WRK-6-MINUTE                 PIC  9(02).             DTSBU005
00070          10  WRK-6-SECOND                 PIC  9(02).             DTSBU005
00071                                                                      CL**5
00072      05  WRK-ABS-TIME                     PIC S9(08)  COMP.       DTSBU005
00073      05  WRK-ABS-MIN                      PIC S9(08)  COMP.       DTSBU005
00074      05  WRK-ABS-SEC                      PIC  9(08).             DTSBU005
00075      05  FILLER REDEFINES WRK-ABS-SEC.                            DTSBU005
00076          10  WRK-ABS-SEC-1                PIC  9(03).             DTSBU005
00077          10  WRK-ABS-SEC-2                PIC  9(02).             DTSBU005
00078          10  WRK-ABS-SEC-3                PIC  9(03).             DTSBU005
00079                                                                      CL**5
00080      05  WRK-ACCEPTED-DATE.                                       DTSBU005
00081          10  WRK-ACCEPTED-YY              PIC  9(02).             DTSBU005
00082          10  WRK-ACCEPTED-MM              PIC  9(02).             DTSBU005
00083          10  WRK-ACCEPTED-DD              PIC  9(02).             DTSBU005
00084      SKIP3                                                        DTSBU005
00085  01  L001-LINK-AREA.                                              DTSBU005
00086  ++INCLUDE DTSIL001                                                  CL**3
00087      EJECT                                                        DTSBU005
00088  LINKAGE SECTION.                                                 DTSBU005
00089      SKIP3                                                        DTSBU005
00090  01  L005-LINK-AREA.                                              DTSBU005
00091  ++INCLUDE DTSIL005                                                  CL**3
00092      EJECT                                                        DTSBU005
00093  PROCEDURE DIVISION                                               DTSBU005
00094      USING L005-LINK-AREA.                                        DTSBU005
00095                                                                      CL**5
00096      IF L005-FROM-SYS                                             DTSBU005
00097          PERFORM P1000-FROM-SYS THRU                                 CL**2
00098                  P1000-FROM-SYS-EXIT                                 CL**2
00099      ELSE                                                         DTSBU005
00100      IF L005-FROM-ABSTIME                                         DTSBU005
00101          PERFORM P2000-FROM-ABSTIME THRU                             CL**2
00102                  P2000-FROM-ABSTIME-EXIT                             CL**2
00103      ELSE                                                         DTSBU005
00104      IF L005-FROM-NINES-COMPLEMENT                                DTSBU005
00105          PERFORM P3000-FROM-ABSTIME-C THRU                           CL**2
00106                  P3000-FROM-ABSTIME-C-EXIT                           CL**2
00107      ELSE                                                         DTSBU005
00108      IF L005-FROM-DATE-TIME                                       DTSBU005
00109          PERFORM P4000-FROM-DATE-TIME THRU                           CL**2
00110                  P4000-FROM-DATE-TIME-EXIT                           CL**4
00111      ELSE                                                         DTSBU005
00112          PERFORM S999-ABEND THRU                                     CL**2
00113                  S999-ABEND-EXIT.                                    CL**2
00114                                                                      CL**5
00115      GOBACK.                                                      DTSBU005
00116      EJECT                                                        DTSBU005
00117  P1000-FROM-SYS.                                                  DTSBU005
00118      PERFORM S1000-SYS-ASKTIME THRU                                  CL**2
00119              S1000-SYS-ASKTIME-EXIT.                                 CL**2
00120      PERFORM S2000-ABSTIME-C THRU                                    CL**2
00121              S2000-ABSTIME-C-EXIT.                                   CL**2
00122      PERFORM S3000-FORMAT-TIME THRU                                  CL**2
00123              S3000-FORMAT-TIME-EXIT.                                 CL**2
00124      PERFORM S5000-SLASH-DATE THRU                                   CL**2
00125              S5000-SLASH-DATE-EXIT.                                  CL**2
00126      MOVE WRK-6-TIME TO L005-TIME.                                DTSBU005
00127      PERFORM S6000-SHOW-TIME THRU                                    CL**2
00128              S6000-SHOW-TIME-EXIT.                                   CL**2
00129      MOVE WS-DATE-FORMAT TO L001-CAL-6-DATE-9.                    DTSBU005
00130      MOVE '4' TO L001-OPTION.                                     DTSBU005
00131      PERFORM S001-DATE THRU                                          CL**2
00132              S001-DATE-EXIT.                                         CL**2
00133      MOVE L001-FED-8-DATE-9 TO L005-DATE.                         DTSBU005
00134      MOVE L001-SLASH-8-DATE TO L005-SLASH-8-DATE.                    CL**5
00135      PERFORM S8000-SHOW-DATE-8 THRU S8000-EXIT.                      CL**6
00136  P1000-FROM-SYS-EXIT. EXIT.                                          CL**2
00137      SKIP3                                                        DTSBU005
00138  P2000-FROM-ABSTIME.                                              DTSBU005
00139      PERFORM S2000-ABSTIME-C THRU                                    CL**2
00140              S2000-ABSTIME-C-EXIT.                                   CL**2
00141      PERFORM S3000-FORMAT-TIME THRU                                  CL**2
00142              S3000-FORMAT-TIME-EXIT.                                 CL**2
00143      PERFORM S4000-ABS-DAYS THRU                                     CL**2
00144              S4000-ABS-DAYS-EXIT.                                    CL**2
00145      PERFORM S5000-SLASH-DATE THRU                                   CL**2
00146              S5000-SLASH-DATE-EXIT.                                  CL**2
00147      MOVE WRK-6-TIME TO L005-TIME.                                DTSBU005
00148      PERFORM S6000-SHOW-TIME THRU                                    CL**2
00149              S6000-SHOW-TIME-EXIT.                                   CL**2
00150      MOVE WS-DATE-FORMAT TO L001-CAL-6-DATE-9.                    DTSBU005
00151      MOVE '4' TO L001-OPTION.                                     DTSBU005
00152      PERFORM S001-DATE THRU                                          CL**2
00153              S001-DATE-EXIT.                                         CL**2
00154      MOVE L001-FED-8-DATE-9 TO L005-DATE.                         DTSBU005
00155      MOVE L001-SLASH-8-DATE TO L005-SLASH-8-DATE.                    CL**5
00156      PERFORM S8000-SHOW-DATE-8 THRU S8000-EXIT.                      CL**6
00157  P2000-FROM-ABSTIME-EXIT. EXIT.                                      CL**2
00158      SKIP3                                                        DTSBU005
00159  P3000-FROM-ABSTIME-C.                                            DTSBU005
00160      PERFORM S7000-ABSTIME THRU                                      CL**2
00161              S7000-ABSTIME-EXIT.                                     CL**2
00162      PERFORM S3000-FORMAT-TIME THRU                                  CL**2
00163              S3000-FORMAT-TIME-EXIT.                                 CL**2
00164      PERFORM S4000-ABS-DAYS THRU                                     CL**2
00165              S4000-ABS-DAYS-EXIT.                                    CL**2
00166      PERFORM S5000-SLASH-DATE THRU                                   CL**2
00167              S5000-SLASH-DATE-EXIT.                                  CL**2
00168      MOVE WRK-6-TIME TO L005-TIME.                                DTSBU005
00169      PERFORM S6000-SHOW-TIME THRU                                    CL**2
00170              S6000-SHOW-TIME-EXIT.                                   CL**2
00171      MOVE WS-DATE-FORMAT TO L001-CAL-6-DATE-9.                    DTSBU005
00172      MOVE '4' TO L001-OPTION.                                     DTSBU005
00173      PERFORM S001-DATE THRU                                          CL**2
00174              S001-DATE-EXIT.                                         CL**2
00175      MOVE L001-FED-8-DATE-9 TO L005-DATE.                         DTSBU005
00176      MOVE L001-SLASH-8-DATE TO L005-SLASH-8-DATE.                    CL**5
00177      PERFORM S8000-SHOW-DATE-8 THRU S8000-EXIT.                      CL**6
00178  P3000-FROM-ABSTIME-C-EXIT.  EXIT.                                   CL**2
00179      SKIP3                                                        DTSBU005
00180  P4000-FROM-DATE-TIME.                                            DTSBU005
00181      MOVE 19300101 TO L001-FED-8-DATE-9.                          DTSBU005
00182      MOVE '1' TO L001-OPTION.                                     DTSBU005
00183      PERFORM S001-DATE THRU                                          CL**2
00184              S001-DATE-EXIT.                                         CL**2
00185      MOVE L001-JUL-ABS-DAY TO JAN011930-ABS-DAY.                  DTSBU005
00186      MOVE L005-DATE TO L001-FED-8-DATE-9.                         DTSBU005
00187      MOVE '1' TO L001-OPTION.                                     DTSBU005
00188      PERFORM S001-DATE THRU                                          CL**2
00189              S001-DATE-EXIT.                                         CL**2
00190      IF L001-INVALID-DATE                                         DTSBU005
00191          PERFORM S999-ABEND THRU                                     CL**2
00192                  S999-ABEND-EXIT.                                    CL**2
00193      COMPUTE ABS-DAYS-FROM-01011900                               DTSBU005
00194         = FIRST-30-YEARS + (L001-JUL-ABS-DAY - JAN011930-ABS-DAY).DTSBU005
00195      MOVE L005-TIME TO WRK-6-TIME.                                DTSBU005
00196      COMPUTE L005-ABSTIME                                         DTSBU005
00197          = (ABS-DAYS-FROM-01011900 * MSEC-PER-DAY)                DTSBU005
00198          + (WRK-6-HOUR * MSEC-PER-HOUR)                           DTSBU005
00199          + (WRK-6-MINUTE * MSEC-PER-MINUTE)                       DTSBU005
00200          + (WRK-6-SECOND * MSEC-PER-SECOND).                      DTSBU005
00201      PERFORM S2000-ABSTIME-C THRU                                    CL**2
00202              S2000-ABSTIME-C-EXIT.                                   CL**2
00203      MOVE L001-SLASH-DATE TO L005-SLASH-DATE.                     DTSBU005
00204      MOVE L001-SLASH-8-DATE TO L005-SLASH-8-DATE.                    CL**5
00205      PERFORM S6000-SHOW-TIME THRU                                    CL**2
00206              S6000-SHOW-TIME-EXIT.                                   CL**2
00207      PERFORM S8000-SHOW-DATE-8 THRU S8000-EXIT.                      CL**6
00208  P4000-FROM-DATE-TIME-EXIT.  EXIT.                                   CL**2
00209      EJECT                                                        DTSBU005
00210  S001-DATE.                                                       DTSBU005
00211                                                                      CL**5
00212      CALL 'DTSBU001' USING L001-LINK-AREA.                           CL**2
00213                                                                      CL**5
00214  S001-DATE-EXIT. EXIT.                                               CL**2
00215      SKIP3                                                        DTSBU005
00216  S999-ABEND.                                                      DTSBU005
00217                                                                      CL**5
00218      CALL 'DTSBU999' USING WRK-ABEND-CD.                             CL**2
00219                                                                      CL**5
00220  S999-ABEND-EXIT. EXIT.                                              CL**2
00221      EJECT                                                        DTSBU005
00222  S1000-SYS-ASKTIME.                                               DTSBU005
00223      MOVE 19300101         TO L001-FED-8-DATE-9.                  DTSBU005
00224      MOVE '1'              TO L001-OPTION.                        DTSBU005
00225      PERFORM S001-DATE THRU                                          CL**2
00226              S001-DATE-EXIT.                                         CL**2
00227      MOVE L001-JUL-ABS-DAY TO JAN011930-ABS-DAY.                  DTSBU005
00228      ACCEPT WRK-ACCEPTED-DATE FROM DATE.                          DTSBU005
00229      MOVE WRK-ACCEPTED-MM  TO WS-DATE-MO                          DTSBU005
00230                               L001-CAL-6-MO.                      DTSBU005
00231      MOVE WRK-ACCEPTED-DD  TO WS-DATE-DAY                         DTSBU005
00232                               L001-CAL-6-DA.                      DTSBU005
00233      MOVE WRK-ACCEPTED-YY  TO WS-DATE-YEAR                        DTSBU005
00234                               L001-CAL-6-YR.                      DTSBU005
00235      PERFORM S5000-SLASH-DATE THRU                                   CL**2
00236              S5000-SLASH-DATE-EXIT.                                  CL**2
00237      MOVE '4'              TO L001-OPTION.                        DTSBU005
00238      PERFORM S001-DATE THRU                                          CL**2
00239              S001-DATE-EXIT.                                         CL**2
00240      MOVE L001-CAL-6-DATE-X TO WS-DATE-FORMAT.                    DTSBU005
00241      MOVE L001-SLASH-8-DATE TO L005-SLASH-8-DATE.                    CL**5
00242      IF L001-INVALID-DATE                                         DTSBU005
00243          PERFORM S999-ABEND THRU S999-ABEND-EXIT.                    CL**2
00244      COMPUTE ABS-DAYS-FROM-01011900                               DTSBU005
00245         = FIRST-30-YEARS + (L001-JUL-ABS-DAY - JAN011930-ABS-DAY).DTSBU005
00246      ACCEPT WRK-8-TIME FROM TIME.                                 DTSBU005
00247      MOVE WRK-8-HOUR-MIN-SEC TO WRK-6-TIME.                       DTSBU005
00248      COMPUTE L005-ABSTIME                                         DTSBU005
00249          = (ABS-DAYS-FROM-01011900 * MSEC-PER-DAY)                DTSBU005
00250          + (WRK-6-HOUR * MSEC-PER-HOUR)                           DTSBU005
00251          + (WRK-6-MINUTE * MSEC-PER-MINUTE)                       DTSBU005
00252          + (WRK-6-SECOND * MSEC-PER-SECOND).                      DTSBU005
00253  S1000-SYS-ASKTIME-EXIT.   EXIT.                                     CL**2
00254      SKIP3                                                        DTSBU005
00255  S2000-ABSTIME-C.                                                 DTSBU005
00256      COMPUTE L005-NINES-COMPLEMENT-ABSTIME                        DTSBU005
00257        = 999999999999999 - L005-ABSTIME.                          DTSBU005
00258  S2000-ABSTIME-C-EXIT. EXIT.                                         CL**2
00259      SKIP3                                                        DTSBU005
00260  S3000-FORMAT-TIME.                                               DTSBU005
00261      DIVIDE L005-ABSTIME BY MSEC-PER-DAY                          DTSBU005
00262             GIVING WRK-JUL-ABS-DAY                                DTSBU005
00263             REMAINDER WRK-ABS-TIME.                               DTSBU005
00264                                                                   DTSBU005
00265      DIVIDE WRK-ABS-TIME BY MSEC-PER-HOUR                         DTSBU005
00266             GIVING WRK-6-HOUR                                     DTSBU005
00267             REMAINDER WRK-ABS-MIN                                 DTSBU005
00268                                                                   DTSBU005
00269      DIVIDE WRK-ABS-MIN BY  MSEC-PER-MINUTE                       DTSBU005
00270             GIVING WRK-6-MINUTE                                   DTSBU005
00271             REMAINDER WRK-ABS-SEC.                                DTSBU005
00272                                                                   DTSBU005
00273      MOVE WRK-ABS-SEC-2 TO WRK-6-SECOND.                          DTSBU005
00274  S3000-FORMAT-TIME-EXIT. EXIT.                                       CL**2
00275      SKIP3                                                        DTSBU005
00276  S4000-ABS-DAYS.                                                  DTSBU005
00277      MOVE 19300101         TO L001-FED-8-DATE-9.                  DTSBU005
00278      MOVE '1'              TO L001-OPTION.                        DTSBU005
00279      PERFORM S001-DATE THRU                                          CL**2
00280              S001-DATE-EXIT.                                         CL**2
00281      MOVE L001-JUL-ABS-DAY TO JAN011930-ABS-DAY.                  DTSBU005
00282      COMPUTE L001-JUL-ABS-DAY                                     DTSBU005
00283         = (JAN011930-ABS-DAY - FIRST-30-YEARS + WRK-JUL-ABS-DAY). DTSBU005
00284      MOVE '3' TO L001-OPTION.                                     DTSBU005
00285      PERFORM S001-DATE THRU                                          CL**2
00286              S001-DATE-EXIT.                                         CL**2
00287      MOVE L001-CAL-6-DATE-9 TO WS-DATE-FORMAT.                    DTSBU005
00288  S4000-ABS-DAYS-EXIT. EXIT.                                          CL**2
00289      SKIP3                                                        DTSBU005
00290  S5000-SLASH-DATE.                                                DTSBU005
00291      MOVE '  /  /  ' TO L005-SLASH-DATE.                          DTSBU005
00292      MOVE WS-DATE-MO TO L005-SLASH-MO.                            DTSBU005
00293      MOVE WS-DATE-DAY TO L005-SLASH-DA.                           DTSBU005
00294      MOVE WS-DATE-YEAR TO L005-SLASH-YR.                          DTSBU005
00295  S5000-SLASH-DATE-EXIT. EXIT.                                        CL**2
00296      SKIP3                                                        DTSBU005
00297  S6000-SHOW-TIME.                                                 DTSBU005
00298      MOVE '  :  :  ' TO L005-DISPLAY-TIME.                        DTSBU005
00299      MOVE WRK-6-HOUR TO L005-DISPLAY-H.                           DTSBU005
00300      MOVE WRK-6-MINUTE TO L005-DISPLAY-M.                         DTSBU005
00301      MOVE WRK-6-SECOND TO L005-DISPLAY-S.                         DTSBU005
00302  S6000-SHOW-TIME-EXIT. EXIT.                                         CL**2
00303      SKIP3                                                        DTSBU005
00304  S7000-ABSTIME.                                                   DTSBU005
00305      COMPUTE L005-ABSTIME                                         DTSBU005
00306          = 999999999999999 - L005-NINES-COMPLEMENT-ABSTIME.       DTSBU005
00307  S7000-ABSTIME-EXIT. EXIT.                                           CL**2
00308      SKIP3                                                           CL**6
00309  S8000-SHOW-DATE-8.                                                  CL**7
00310      MOVE '        /      ' TO L005-DATE-8-SLASH-TIME.               CL**6
00311                                                                      CL**6
00312                                                                      CL**6
00313      MOVE L005-DATE TO L001-FED-8-DATE-9.                            CL**6
00314                                                                      CL**6
00315      MOVE L001-FED-8-MO TO L005-DATE-8-MO.                           CL**7
00316                                                                      CL**6
00317      MOVE L001-FED-8-DA TO L005-DATE-8-DA.                           CL**6
00318                                                                      CL**6
00319      MOVE L001-FED-8-YR TO L005-DATE-8-YR.                           CL**6
00320                                                                      CL**6
00321                                                                      CL**6
00322      MOVE L005-TIME TO WRK-6-TIME.                                   CL**6
00323                                                                      CL**6
00324      MOVE WRK-6-HOUR TO L005-TIME-HH.                                CL**6
00325                                                                      CL**6
00326      MOVE WRK-6-MINUTE TO L005-TIME-MM.                              CL**6
00327                                                                      CL**6
00328      MOVE WRK-6-SECOND TO L005-TIME-SS.                              CL**6
00329  S8000-EXIT.                                                         CL**6
00330      EXIT.                                                           CL**6
