IBM Mainframe Forum Index
 
Log In
 
IBM Mainframe Forum Index Mainframe: Search IBM Mainframe Forum: FAQ Register
 

COBOL Program "COBGMTO"


IBM Mainframe Forums -> COBOL Programming
Post new topic   Reply to topic
View previous topic :: View next topic  
Author Message
Bill O'Boyle

CICS Moderator


Joined: 14 Jan 2008
Posts: 2501
Location: Atlanta, Georgia, USA

PostPosted: Wed Nov 13, 2013 9:54 pm
Reply with quote

Below, please find COBOL Sub-Program "COBGMTO" which returns the Local <---> GMT offset, with a format of "-/+HHMM'. It's fully re-entrant and can be used in both Batch and CICS. It's a cousin to "GETGMTO", posted in the PL/I and Assembler Forum.

Code:

       IDENTIFICATION DIVISION.                                         
       PROGRAM-ID. COBGMTO INITIAL.                                     
      *                                                                 
      **** CALL SYNTAX EXAMPLE:                                         
      *                                                                 
      **** 03  WS-COBGMTO-PARM.                                         
      ****     05  WS-COBGMTO-VALUE                                     
      ****                         PIC  X(05).                         
      ****     05  FILLER          REDEFINES WS-COBGMTO-VALUE.         
      ****         07  WS-COBGMTO-SIGN                                 
      ****                         PIC  X(01).                         
      ****             88  WS-COBGMTO-BEHIND-GMT   VALUE '-'.           
      ****         07  WS-COBGMTO-HHMM                                 
      ****                         PIC  9(04).                         
      ****     05  WS-COBGMTO-WKAREA                                   
      ****                         PIC  X(80).                         
      **** 03  WS-COBGMTO          PIC  X(08)      VALUE 'COBGMTO'.     
      *                                                                 
      **** CALL WS-COBGMTO             USING WS-COBGMTO-PARM.           
      *                                                                 
      **** THE PARM DOES NOT NEED TO BE INITIALISED.                   
      *                                                                 
       ENVIRONMENT DIVISION.                                           
       DATA DIVISION.                                                   
       WORKING-STORAGE SECTION.                                         
       LINKAGE SECTION.                                                 
       01  LS-PARM-REC.                                                 
           03  LS-PARM-OFFSET      PIC  X(05).                         
           03  FILLER              REDEFINES LS-PARM-OFFSET.           
               05  LS-PARM-OFFSET-SIGN                                 
                                   PIC  X(01).                         
               05  LS-PARM-OFFSET-HH                                   
                                   PIC  9(02).                         
               05  LS-PARM-OFFSET-MM                                   
                                   PIC  9(02).                         
           03  LS-PARM-OFFSET-WORKAREA.                                 
               05  LS-DWORD        PIC  9(15)      PACKED-DECIMAL.     
               05  LS-FWORD        PIC  9(08)      BINARY.             
               05  LS-FWORD-X      REDEFINES LS-FWORD                   
                                   PIC  X(04).                         
               05  LS-POINTER      POINTER.                             
               05  LS-POINTER-X    REDEFINES LS-POINTER                 
                                   PIC  X(04).                         
               05  LS-CVTTZ        PIC S9(08)      BINARY.             
               05  LS-CVTTZ-X      REDEFINES LS-CVTTZ                   
                                   PIC  X(04).                         
               05  FILLER          PIC  X(60).                         
       01  LS-DUMMY-DSECT          PIC  X(1024).                       
       PROCEDURE DIVISION USING LS-PARM-REC.                           
       0000-BEGIN-COBGMTO.                                             
       *                                                               
       **** IN LOW-CORE, AT FIXED-POSITION X'00000010', IS THE ADDRESS 
       **** OF THE 'CVT' (COMMUNICATIONS VECTOR TABLE). WE MUST MOVE THE
       **** ADDRESS LOCATED AT THIS FIXED-POSITION TO A 'POINTER', WHICH
       **** WILL THEN BE USED TO ESTABLISH ADDRESSABILITY TO THE       
       **** START OF THE 'CVT'.                                         
       *                                                               
           MOVE LOW-VALUES             TO LS-PARM-OFFSET-WORKAREA.     
           MOVE X'10'                  TO LS-POINTER-X (4:).           
           SET  ADDRESS OF LS-DUMMY-DSECT                               
                                       TO LS-POINTER.                   
           MOVE LS-DUMMY-DSECT         TO LS-POINTER-X.                 
           SET  ADDRESS OF LS-DUMMY-DSECT                               
                                       TO LS-POINTER.                   
      *                                                                 
      **** THE 'CVTTZ' IS LOCATED AT X'130' OFF THE START OF THE 'CVT',
      **** FOR THIS z/OS VERSION/RELEASE. PERSONNEL SHOULD CHECK THE   
      **** OFFSET (CVTTZ) UPON ANY UPGRADE OF THE OPERATING SYSTEM AND 
      **** ENSURE THE OFFSET OF THIS FIELD HASN'T CHANGED.             
      *                                                                 
      **** WHEN ADDRESSING OFFSETS IN COBOL, WE MUST ADD 1 TO ENSURE   
      **** PROPER ADDRESSABILITY. IN THIS CASE, WE MUST SPECIFY X'131' 
      **** (305) INSTEAD OF X'130' (304).                               
      *                                                                 
      **** BECAUSE OUR RECEIVING FIELD IS AN UNSIGNED-FWORD, THE       
      **** COMPILER ISSUES A 'LPR', TO ENSURE A POSITIVE VALUE.         
      *                                                                 
           MOVE LS-DUMMY-DSECT (305:)  TO LS-CVTTZ-X.                   
           MOVE LS-CVTTZ               TO LS-FWORD.                     
           MOVE LS-FWORD               TO LS-DWORD.                     
      *                                                                 
      **** NOW, CALCULATE THE OFFSET, RESULTING IN A '+/-HHMM' VALUE.   
      *                                                                 
           COMPUTE LS-DWORD            = (LS-DWORD * 1048576).         
           COMPUTE LS-DWORD            = (LS-DWORD / 1000000).         
           DIVIDE  LS-DWORD            BY 3600                         
                                       GIVING LS-PARM-OFFSET-HH         
                                       REMAINDER LS-DWORD.             
      *                                                                 
      **** IF THERE'S A REMAINDER AFTER THE DIVIDE, THEN THE GMT       
      **** OFFSET REST'S ON A 15 OR 30 MINUTE BOUNDARY, SUCH AS         
      **** PAKISTAN OR INDIA, RESPECTIVELY.                             
      *                                                                 
           IF  LS-DWORD > 59                                           
               COMPUTE LS-DWORD        = (LS-DWORD / 60)               
               IF  LS-DWORD > 29                                       
                   MOVE 30             TO LS-PARM-OFFSET-MM             
               ELSE                                                     
                   MOVE 15             TO LS-PARM-OFFSET-MM             
               END-IF                                                   
           ELSE                                                         
               MOVE ZERO               TO LS-PARM-OFFSET-MM             
           END-IF.                                                     
      *                                                                 
      **** IF THE 'CVTTZ' IS NEGATIVE, THEN THE OFFSET SIGN IS '-'.     
      **** OTHERWISE, IT'S '+'.                                         
      *                                                                 
           IF  LS-CVTTZ-X (1:1) > X'7F'                                 
               MOVE '-'                TO LS-PARM-OFFSET-SIGN           
           ELSE                                                         
               MOVE '+'                TO LS-PARM-OFFSET-SIGN           
           END-IF.                                                     
      *                                                                 
      **** IF THE 'HHMM' PARM-OFFSET IS NON-ZERO, THEN SET THE RC TO   
      **** ZERO. OTHERWISE, SET IT TO 4 TO NOTIFY THE CALLER AS A       
      **** WARNING.                                                     
      *                                                                 
           IF  LS-PARM-OFFSET (2:) NOT = ZERO                           
               MOVE ZERO               TO RETURN-CODE                   
           ELSE                                                         
               MOVE 4                  TO RETURN-CODE                   
           END-IF.                                                     
      *                                                                 
           MOVE LOW-VALUES             TO LS-PARM-OFFSET-WORKAREA.     
      *                                                                 
       9999-END-COBGMTO.                                               
      *                                                                 
           GOBACK.                                                     
Back to top
View user's profile Send private message
View previous topic :: :: View next topic  
Post new topic   Reply to topic View Bookmarks
All times are GMT + 6 Hours
Forum Index -> COBOL Programming

 


Similar Topics
Topic Forum Replies
No new posts Replacing FILLER with FILLER<SeqNu... DFSORT/ICETOOL 2
No new posts Error to invoke MPP program through B... IMS DB/DC 3
No new posts Compile Sp Cobol base COBOL Programming 1
No new posts SQLCODE=-311 in Cobol SP-DB2. COBOL Programming 2
No new posts COBOL 6.4 - User Defined Function nee... COBOL Programming 6
Search our Forums:

Back to Top