fork(5) download
copy 
  1. IDENTIFICATION DIVISION.                                         
  2.  PROGRAM-ID. TRCHF56A.                                            
  3.  AUTHOR. BEAUTILIN D.                                             
  4.  ENVIRONMENT DIVISION.                                            
  5.  DATA DIVISION.                                                   
  6. ******************************************************************
  7.  WORKING-STORAGE SECTION.                                         
  8.  01 WS-COMMUNICATION-AREA.                                        
  9.      05 WS-COMMAREA          PIC         X(3).                    
  10.      05 WS-TOP-INDEX         PIC         S9(4)      COMP.         
  11.      05 WS-BOTTOM-INDEX      PIC         S9(4)      COMP.         
  12.      05 WS-NUMITEMS          PIC         S9(4)      COMP.         
  13.      05 WS-TS-ID             PIC         X(8).                    
  14. *                                                                 
  15.  01 FLAGS.                                                        
  16.     05 WF-ERR-FLAG       PIC   X(01).                             
  17.     05 WF-EIBCALEN-FLAG  PIC   X(01).                             
  18.        88 C-ZERO                      VALUE '1'.                  
  19.        88 C-NONZERO                   VALUE '2'.                  
  20. *                                                                 
  21.  01 WS-ERROR-DESC        PIC   X(20)  VALUE SPACES.               
  22.  01 WS-CICS-RESP         PIC   S9(08).                            
  23.  01 WS-UTIME             PIC   X(15).                             
  24.  01 WS-SDATE             PIC   X(10).                             
  25.  01 WS-SESSION-ENDED     PIC   X(10).                             
  26. *******FOLLOWING COPYBOOK IS REQUIRED TO TRAP THE FUNCTION KEYS***
  27. * COPY DFHAID.                                                     
  28. *******BELOW IS THE COPYBOOK PERTAINING TO THE SYMBOLIC MAP*******
  29.  COPY TRCH56A.                                                    
  30.  LINKAGE SECTION.                                                 
  31.  01 DFHCOMMAREA.                                                  
  32.      05 L-COMMAREA          PIC         X(3).                     
  33.      05 L-TOP-INDEX         PIC         S9(4)      COMP.          
  34.      05 L-BOTTOM-INDEX      PIC         S9(4)      COMP.          
  35.      05 L-TOTAL             PIC         S9(4)      COMP.          
  36.      05 L-TS-ID             PIC         X(8).                     
  37.  PROCEDURE DIVISION.                                              
  38.  MAIN-PARA.                                                       
  39.      MOVE     DFHCOMMAREA   TO    WS-COMMUNICATION-AREA           
  40.      PERFORM  EIB-PARA      THRU  EIB-PARA-EXIT                   
  41.      PERFORM  PROCESS-PARA  THRU  PROCESS-PARA-EXIT               
  42.      STOP RUN.                                                    
  43. ******************************************************************
  44.  EIB-PARA.                                                        
  45. ***WHEN TF56 TRANSACTION IS INVOKED VERY FIRST TIME, EIBCALEN WILL
  46. ***BE ZERO                                                        
  47.      IF EIBCALEN = 0                                              
  48.         SET C-ZERO    TO  TRUE                                    
  49.      ELSE                                                         
  50.         SET C-NONZERO TO  TRUE                                    
  51.      END-IF.                                                      
  52.  EIB-PARA-EXIT.                                                   
  53.      EXIT.                                                        
  54. ******************************************************************
  55.  PROCESS-PARA.                                                    
  56.      PERFORM  DATE-TIME  THRU  DATE-TIME-EXIT                     
  57.      PERFORM  START-PGM  THRU  START-PGM-EXIT                     
  58.      IF C-ZERO                                                    
  59.         PERFORM  SEND-MAP    THRU   SEND-MAP-EXIT                 
  60.         MOVE     'MEN'       TO     WS-COMMAREA                   
  61.         PERFORM  RETURN-CICS THRU   RETURN-CICS-EXIT              
  62.      END-IF                                                       
  63.      IF C-NONZERO                                                 
  64.         EVALUATE WS-COMMAREA                                      
  65.           WHEN 'MEN'                                              
  66.              PERFORM KEY-VALIDATION  THRU   KEY-VALIDATION-EXIT   
  67.         END-EVALUATE                                              
  68.      END-IF.                                                      
  69.  PROCESS-PARA-EXIT.                                               
  70.      EXIT.                                                        
  71. ******************************************************************
  72.  START-PGM.                                                       
  73. *****INITIALIZE THE MAP VARIABLES BEFORE DOING SEND MAP********** 
  74.      MOVE LOW-VALUES  TO  TRH056AO.                               
  75.      MOVE WS-UTIME    TO  TIMEO.                                  
  76.      MOVE WS-SDATE    TO  DATEO.                                  
  77.  
  78.  START-PGM-EXIT.                                                  
  79.      EXIT.                                                        
  80. ******************************************************************
  81.  SEND-MAP.                                                        
  82. ***FOLLOWING WILL SEND THE MAP CONTENTS PRESENT IN TRH056AO       
  83.      EXEC CICS                                                    
  84.           SEND MAP ('TRCH56A')                                    
  85.           FROM     (TRH056AO)                                     
  86.           ERASE                                                   
  87.           FREEKB                                                  
  88.           RESP     (WS-CICS-RESP)                                 
  89.      END-EXEC                                                     
  90.      PERFORM CICS-RESPONSE THRU CICS-RESPONSE-EXIT.               
  91.  SEND-MAP-EXIT.                                                   
  92.      EXIT.                                                        
  93. ******************************************************************
  94.  RETURN-CICS.                                                     
  95. **FOLLOWING WILL RETURN THE CONTROL TO CICS                       
  96.      EXEC CICS                                                    
  97.           RETURN                                                  
  98.           TRANSID  ('TF56')                                       
  99.           COMMAREA (WS-COMMAREA)                                  
  100.           RESP     (WS-CICS-RESP)                                 
  101.      END-EXEC                                                     
  102.      PERFORM CICS-RESPONSE THRU CICS-RESPONSE-EXIT.               
  103.  RETURN-CICS-EXIT.                                                
  104.      EXIT.                                                        
  105. ******************************************************************
  106.  EXIT-CICS.                                                       
  107. ********* FOLLOWING WILL RETURN THE CONTROL TOTALLY TO CICS ******
  108.      EXEC CICS                                                    
  109.           RETURN                                                  
  110.      END-EXEC.                                                    
  111.  EXIT-CICS-EXIT.                                                  
  112.      EXIT.                                                        
  113. ******************************************************************
  114.  KEY-VALIDATION.                                                  
  115.      EVALUATE EIBAID                                              
  116.         WHEN DFHENTER                                             
  117. *****INITIALIZE THE MAP VARIABLES BEFORE DOING RECEIVE MAP********
  118.              MOVE LOW-VALUES TO TRH056AI                          
  119.              PERFORM RECEIVE-MAP      THRU  RECEIVE-MAP-EXIT      
  120. *            PERFORM PROCESS-RECEIVE  THRU  PROCESS-RECEIVE-EXIT  
  121.         WHEN DFHPF3                                               
  122. *****SEND BLANK SCREEN AND RETURN TO CICS WHEN F3 IS PRESSED******
  123.              PERFORM SEND-BLANK-SCREEN THRU  SEND-BLANK-EXIT      
  124.              PERFORM EXIT-CICS         THRU  EXIT-CICS-EXIT       
  125.         WHEN OTHER                                                
  126.              PERFORM START-PGM    THRU  START-PGM-EXIT            
  127.              MOVE 'INVALID KEY '  TO    MSG1O                     
  128.              PERFORM SEND-MAP     THRU  SEND-MAP-EXIT             
  129.              MOVE    'MEN'        TO    WS-COMMAREA               
  130.              PERFORM RETURN-CICS  THRU  RETURN-CICS-EXIT          
  131.      END-EVALUATE.                                                
  132.  KEY-VALIDATION-EXIT.                                             
  133.      EXIT.                                                        
  134.  SEND-BLANK-SCREEN.                                               
  135.      MOVE SPACES TO WS-SESSION-ENDED                              
  136.      EXEC CICS SEND TEXT FROM (WS-SESSION-ENDED)                  
  137.                     ERASE FREEKB END-EXEC.                        
  138.  SEND-BLANK-EXIT.                                                 
  139.      EXIT.                                                        
  140. ******************************************************************
  141.  RECEIVE-MAP.                                                     
  142. ***FOLLOWING WILL RECEIVE THE MAP CONTENTS PRESENT IN SCREEN INTO 
  143.      EXEC CICS                                                    
  144.           RECEIVE MAP    ('TRCH56A')                              
  145.                   MAPSET ('TRCH56A')                              
  146.                   INTO   (TRH056AI)                               
  147.                   RESP   (WS-CICS-RESP)                           
  148.      END-EXEC                                                     
  149.      PERFORM CICS-RESPONSE THRU CICS-RESPONSE-EXIT                
  150.      .                                                            
  151.  RECEIVE-MAP-EXIT.                                            
  152.      EXIT.                                                    
  153.  CICS-RESPONSE.                                               
  154.      MOVE SPACES TO WS-ERROR-DESC                             
  155.      MOVE 'Y' TO WF-ERR-FLAG                                  
  156.      EVALUATE WS-CICS-RESP                                    
  157.         WHEN DFHRESP(NORMAL)                                  
  158.              MOVE 'N'                     TO  WF-ERR-FLAG     
  159.         WHEN DFHRESP(FILENOTFOUND)                            
  160.              MOVE 'DATASET ID ERROR'      TO  WS-ERROR-DESC   
  161.         WHEN DFHRESP(INVREQ)                                  
  162.              MOVE 'INVALID REQUEST ERROR' TO  WS-ERROR-DESC   
  163.         WHEN DFHRESP(IOERR)                                   
  164.              MOVE 'IOERROR OCCURED'       TO  WS-ERROR-DESC   
  165.         WHEN DFHRESP(LENGERR)                                 
  166.              MOVE 'LENGTH ERROR'          TO  WS-ERROR-DESC   
  167.         WHEN DFHRESP(NOTAUTH)                                 
  168.              MOVE 'NOT AUTHORIZED ERROR'  TO  WS-ERROR-DESC   
  169.         WHEN DFHRESP(NOSPACE)                                 
  170.              MOVE 'DATASET IS FULL'       TO  WS-ERROR-DESC    
  171.         WHEN DFHRESP(NOTFND)                                   
  172.              MOVE 'RECORD NOT FOUND'      TO  WS-ERROR-DESC    
  173.         WHEN DFHRESP(NOTOPEN)                                  
  174.              MOVE 'DATASET IS CLOSED'     TO  WS-ERROR-DESC    
  175.         WHEN DFHRESP(QIDERR)                                   
  176.              MOVE 'TS QIDERR'             TO  WS-ERROR-DESC    
  177.         WHEN DFHRESP(ITEMERR)                                  
  178.              MOVE 'TS ITEMERR ERROR'      TO  WS-ERROR-DESC    
  179.         WHEN DFHRESP(SYSIDERR)                                 
  180.              MOVE 'SYS ID ERROR'          TO  WS-ERROR-DESC    
  181.         WHEN DFHRESP(DUPKEY)                                   
  182.              MOVE 'DUPLICTE RECORD KEY'   TO  WS-ERROR-DESC    
  183.         WHEN DFHRESP(DUPREC)                                   
  184.              MOVE 'DUPLICATE RECORD'      TO  WS-ERROR-DESC    
  185.         WHEN DFHRESP(PGMIDERR)                                 
  186.              MOVE 'PROGRAM ID ERROR'      TO  WS-ERROR-DESC    
  187.         WHEN OTHER                                             
  188.              MOVE 'UNDEFINED CICS ERROR'  TO  WS-ERROR-DESC    
  189.      END-EVALUATE                                                 
  190.      IF WF-ERR-FLAG = 'Y'                                         
  191.         PERFORM  START-PGM      THRU  START-PGM-EXIT              
  192.         MOVE     WS-ERROR-DESC  TO    MSG1O                       
  193.         PERFORM  SEND-MAP       THRU  SEND-MAP-EXIT               
  194.         PERFORM  RETURN-CICS    THRU  RETURN-CICS-EXIT            
  195.      END-IF.                                                      
  196.  CICS-RESPONSE-EXIT.                                              
  197.      EXIT.                                                        
  198. ********TO GET SYSTEM DATE AND TIME*******************************
  199.  DATE-TIME.                                                       
  200.      EXEC CICS ASKTIME ABSTIME(WS-UTIME) END-EXEC                 
  201.      EXEC CICS FORMATTIME ABSTIME(WS-UTIME)                       
  202.                DATESEP('/') DDMMYYYY(WS-SDATE)                    
  203.                TIME(WS-UTIME) TIMESEP(':')                        
  204.      END-EXEC                                                     
  205.      .                                                            
  206.  DATE-TIME-EXIT.                                                  
  207.      EXIT.                                                        
  208.  
Compilation error #stdin compilation error #stdout 0s 0KB
comments (?)
stdin
copy 
Standard input is empty
compilation info 
error: copybook file TRCH56A not found
stdout
copy 
Standard output is empty
https://ideone.com/oOobx
language:
COBOL 85 (tinycobol-0.65.9)
created:
13 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!