MANTIS CONVERSION TO COBOL
The following example is in conversational mode. The default option
is pseudo-conversational mode.
Names beginning 'UU' are system names generated in the conversion.
Numbers in the left margin refer to original Mantis statements.
/*****************************************************************
* THIS IS A SEGMENTED PROGRAM *
******************************************************************
* ENTRY-NAME: EXPLIA1 *
*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*
20*
* **************************************************************
* EXPLIA1 - OVERRIDE SCREEN 1 ***********
* **************************************************************
* OVERRIDE XXXXXXXXX XXXXXXX (YYYY FROM MAIN
* --------------------------------------------------------------
*
* AMENDMENTS :-
*
* WHY WHO WHEN WHAT
* ----- --- -------- --------------------------------------
* XXXXX XXX 04/03/04 NEW
*
* --------------------------------------------------------------
*
******************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. ANEXMPL.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
******************************************************************
DATA DIVISION.
WORKING-STORAGE SECTION.
/*****************************************************************
* *
* PROGRAM VARIABLES *
* *
******************************************************************
01 UUALL-PROGRAM-VARIABLES.
2 UUSEG-RETURN PIC X(0016).
2 UUSEG-PROGRAM PIC X(0008).
2 UUSER-VARIABLES.
3 UUPROG-PARAMETERS.
5 LOGID PIC X(0004).
5 SDATE PIC X(0010).
** 1 SCREIA1.
** 3 SDATE PIC X(0010).
3 STIME PIC X(0008).
** 3 LOGID PIC X(0004).
3 S-WEB-CODE PIC X(0006).
3 S-NETNAME1 PIC X(0030).
3 S-NETNAME2 PIC X(0030).
3 S-EDI-OVERRIDE PIC X(0001).
3 MESSAGEU PIC X(0079).
** 1 INTF-INTFAC.
3 INTF-SUBNAME PIC X(0008).
3 INTF-RETCD PIC S9(9) COMP.
3 INTF-RETCHAR PIC X(0001).
3 INTF-RESTYPE PIC X(0003).
3 INTF-RESNAME PIC X(0040).
3 INTF-MODID PIC X(0008).
3 INTF-USBUFAREA PIC X(0132).
** 1 FILEDIV.
3 WEB-CODE PIC X(0006).
3 USER-STAMP PIC X(0004).
3 DATE-STAMP PIC X(0008).
3 TIME-STAMP PIC X(0006).
3 WEB-NAME1 PIC X(0030).
3 WEB-NAME2 PIC X(0030).
3 EDI-OVERRIDE PIC X(0001).
** 1 UUPROGDEF.
3 REP PIC X(0001).
** 3 SDATE PIC X(0004).
3 TODAY PIC X(0008).
3 SECTIONU PIC X(0005).
** 3 LOGID PIC X(0004).
3 V-NUM PIC X(0010).
3 WV-NUM PIC X(0010).
3 L PIC S9(4) COMP.
3 X PIC S9(1) COMP.
3 LEN PIC S9(4) COMP.
3 N6 PIC S9(4) COMP.
/*****************************************************************
* *
* WORK VARIABLES (SAVED) *
* *
******************************************************************
2 UUSYS-VARIABLES.
COPY UUPXVAR1.
/*****************************************************************
* *
* MAP CONTROL VARIABLES *
* *
******************************************************************
2 UUMAP-CONTROLS.
3 MAP-UUMCTRL.
5 MAP-UUMAPNAME PIC X(40) VALUE 'SCREIA1'.
5 MAP-UUBMSNAME PIC X(08) VALUE 'SCREI1M'.
3 MAP-UUREPLY.
5 MAP PIC X(08) VALUE SPACE.
5 MAP-UUFKEYL PIC S9(04) COMP VALUE ZERO.
5 MAP-UUMODFIED PIC 9 VALUE ZERO.
/*****************************************************************
* *
* SCREEN CONTROL VARIABLES *
* *
******************************************************************
02 UUSCREEN-MAP.
COPY SCREI1MC REPLACING ==(P)== BY ====.
/*****************************************************************
* *
* FILE/INTERFACE CONTROL VARIABLES *
* *
******************************************************************
2 UUFILE-CONTROLS.
* INTERFACE:
3 INTF-INTF-UURCTRL.
5 INTF PIC X(08) VALUE SPACE.
5 INTF-UUITFNAME PIC X(40) VALUE 'INTFAC'.
5 INTF-UUPRGNAME PIC X(08) VALUE 'EXPR'.
* FILE:
3 FILEDIV-UURCTRL.
5 FILEDIV-UUFIO-STATUS.
7 FILEDIV PIC X(08) VALUE SPACE.
7 FILEDIV-UUFSI PIC X(20) VALUE SPACE.
7 FILEDIV-UUTRAP PIC X(3) VALUE SPACE.
7 FILEDIV-UUKEYU PIC X(254) VALUE SPACE.
5 FILEDIV-UURECNAME PIC X(40) VALUE 'FILEDIV'.
5 FILEDIV-UUEXTNAME PIC X(08) VALUE 'FILEDIV'.
/*****************************************************************
* *
* WORK VARIABLES (TEMPORARY) *
* *
******************************************************************
01 FILLER.
3 UUI001 PIC S9(04) COMP VALUE ZERO.
3 UUSZ01 PIC S9(04) COMP VALUE ZERO.
3 UUPL01 PIC S9(04) COMP VALUE ZERO.
3 UUPL02 PIC S9(04) COMP VALUE ZERO.
01 UU-FILE-DB-STATUS.
3 UUFILE-STATUS.
5 FILEDIV-UUBROWS PIC 9 VALUE ZERO.
*----------------------------------------------------------------*
* WORK VARIABLES:
COPY UUPXVAR2.
* DYNAMIC ATTRIBUTES AND EIBAID VALUES:
COPY UUPXCICV.
* SHOW/MESSAGE DISPLAY:
COPY UUSHMAP.
* CICS/BMS CONSTANTS:
COPY DFHAID.
COPY DFHBMSCA.
* COMMAREA FOR XCTL AND LINK. SCREEN INPUT BUFFER AREA:
COPY UUPXLNKV.
/*****************************************************************
* *
* MAP I/O STRUCTURES FROM BMS *
* *
******************************************************************
*---MAP/SCREIA1/SCREI1M------------------------------------------*
COPY SCREI1M REPLACING SCREI1MI BY SCREIA1I
SCREI1MO BY SCREIA1O.
/*****************************************************************
* *
* FILE/INTERFACE WORK RECORDS *
* *
******************************************************************
*---INTF/INTFAC/IIMP---------------------------------------------*
COPY INTFAC.
/---FILEDIV/FILEDIV/FILEDIV--------------------------------------*
COPY FILEDI.
/*****************************************************************
* *
LINKAGE SECTION.
* *
******************************************************************
01 DFHCOMMAREA PIC X(32763).
/*****************************************************************
* *
PROCEDURE DIVISION.
* *
******************************************************************
* *
* BASE SECTION *
* *
******************************************************************
UUPROGRAM-BASE SECTION.
*---SETTING PROGRAM INITIAL VALUES-------------------------------*
INITIALIZE UUSER-VARIABLES
REPLACING ALPHANUMERIC BY LOW-VALUE
NUMERIC BY ZERO
MOVE 'ANEXMPL' TO UUPROGRAM
MOVE UUPROGRAM TO UUSEG-PROGRAM
INITIALIZE UUFILE-STATUS
* PARAMETER BLOCK (UUF000=0:NO PARAMETERS):
MOVE ZERO TO UUF000
MOVE LENGTH OF UUPROG-PARAMETERS TO UUF000
* CICS INIT:
COPY UUPXCICS.
IF EIBCALEN > ZERO
MOVE DFHCOMMAREA TO UUPROG-PARAMETERS
END-IF
.
*---PERFORMING MAIN SECTION--------------------------------------*
PERFORM EXPLIA1-MAIN.
*---PROGRAM EXIT-------------------------------------------------*
UUPROGRAM-EXIT.
EXEC CICS UNLOCK NOHANDLE FILE('FILEDIV') END-EXEC.
*UUEXIT.
COPY UUPXEXIT.
EXEC CICS RETURN END-EXEC.
*---HARD ERROR IN PROGRAM----------------------------------------*
UUHARDERROR.
MOVE 'UUPERROR' TO UUPROGNAM
GO TO UUEXIT.
/*****************************************************************
* *
* MAIN SECTION *
* *
******************************************************************
EXPLIA1-MAIN SECTION.
PERFORM HOUSEKEEPING
210*
* CONVERSE MAP
ADD 1 TO UUMCONVI
MOVE MAP-UUMCTRL TO UUMCTRL(UUMCONVI)
PERFORM UUMAP-CONVERSE
MOVE UUREPLY TO MAP-UUREPLY
230 CALL UUATRSET USING UUMX-SCREIA1 UUMC-SCREIA1 UUALARM BY
CONTENT '000' ' ' 'RES/'
250* MAIN LOOP
.
PERFORM UNTIL ( UUKEY = 'CANCEL' OR 'CLEAR' )
270 CALL UUATRSET USING UUMX-SCREIA1 UUMC-SCREIA1 UUALARM BY
CONTENT '000' ' ' 'RES/'
280 MOVE LOW-VALUE TO MESSAGEU
290 IF UUKEY NOT = 'ENTER'
300 STRING 'INVALID KEY DEPRESSED - PLEASE TRY AGAIN' UUNULLS
DELIMITED SIZE INTO MESSAGEU
310 END-IF
IF UUKEY = 'ENTER'
320 PERFORM VALIDATE-SCREEN
330 IF MESSAGEU = LOW-VALUE
340 PERFORM ENTER-BIT
350 END-IF
360 END-IF
370*
PERFORM UUGET-TIME
MOVE UUTIME TO STIME
390* CONVERSE MAP
ADD 1 TO UUMCONVI
MOVE MAP-UUMCTRL TO UUMCTRL(UUMCONVI)
PERFORM UUMAP-CONVERSE
MOVE UUREPLY TO MAP-UUREPLY
400 CALL UUATRSET USING UUMX-SCREIA1 UUMC-SCREIA1 UUALARM BY
CONTENT '000' ' ' 'RES/'
410 END-PERFORM
420*
IF UUKEY = 'CLEAR'
PERFORM UNLOCK-FILEDIV
450*CHAIN 'TESTO1'
MOVE 'TEST01' TO UUPROGNAM MOVE 0 TO UUI000
GO TO UUPROGRAM-EXIT
460 ELSE
PERFORM UNLOCK-FILEDIV
480*CHAIN 'EXPLI01' LOGID SDATE
MOVE 'EXPLI01' TO UUPROGNAM MOVE 1 TO UUI000
STRING LOGID SDATE
DELIMITED SIZE
INTO UURMCOMAREA POINTER UUI000 ADD -1 TO UUI000
GO TO UUPROGRAM-EXIT
490 END-IF
.
500*
* ***************************************************************
* EXPLIA1 - SUBROUTINES ******************************
* ***************************************************************
*
*
/++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*
VAL-NUM SECTION.
*PAR#01:V-NUM
* MODIFIED HERE*
*PAR#02:LEN
*PAR#03:REP
* MODIFIED HERE*
590*
MOVE 'N' TO REP
610 IF V-NUM(1:LEN) NOT = LOW-VALUE
620 MOVE 'V' TO REP
630 UNSTRING V-NUM(1:LEN) DELIMITED LOW-VALUE
INTO UUTEXS COUNT UUSZ01
MOVE UUSZ01 TO L
640 MOVE '0000000000' TO WV-NUM
650 IF L > 0
660* ???:* CHECK THE LENGTH OF SUBSTRING:
* WV_NUM(LEN-L+1,LEN)=V_NUM(1,L)
MOVE V-NUM(1:L) TO WV-NUM(LEN - L + 1:L)
670 END-IF
680*
MOVE 1 TO L
700 PERFORM UNTIL NOT ( LEN + 1 > L )
710* ???:* CHECK IF NUMERIC TEST IS OK:
IF WV-NUM(L:1) NOT NUMERIC
720 MOVE 'I' TO REP
730 MOVE LEN TO L
740 END-IF
750 COMPUTE L = L + 1
760 END-PERFORM
770 MOVE WV-NUM(1:LEN) TO V-NUM(1:LEN)
780 END-IF
790*
.
810*
/++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*
VALIDATE-SCREEN SECTION.
850*
MOVE LENGTH OF S-WEB-CODE TO UUI000
CALL UUPPSPAD USING UUI000 S-WEB-CODE BY CONTENT 'UAL' ' '
870 IF S-WEB-CODE = LOW-VALUE OR '000000'
880 MOVE UUMI-S-WEB-CODE OF UUMX-SCREIA1 TO UUN333
CALL UUATRSET USING UUMX-SCREIA1 UUMC-SCREIA1 UUALARM BY
CONTENT UUN333 'T' 'RED,CUR/'
890 STRING
'PLEASE ENTER A NETWORK CODE TO AMEND OVERRIDE DETAILS'
UUNULLS DELIMITED SIZE INTO MESSAGEU
900 ELSE
910 MOVE UUFALSE TO X
920*
STRING S-WEB-CODE UUNULLS DELIMITED SIZE INTO V-NUM
MOVE N6 TO LEN
PERFORM VAL-NUM
STRING V-NUM UUNULLS DELIMITED SIZE INTO S-WEB-CODE
*
930 IF REP = 'I'
940 MOVE UUMI-S-WEB-CODE OF UUMX-SCREIA1 TO UUN333
CALL UUATRSET USING UUMX-SCREIA1 UUMC-SCREIA1 UUALARM BY
CONTENT UUN333 'T' 'RED,CUR/'
950 STRING 'NETWORK CODE MUST BE NUMERIC' UUNULLS DELIMITED
SIZE INTO MESSAGEU
960 END-IF
970 END-IF
980*
.
1000*
/++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*
ENTER-BIT SECTION.
1040*
MOVE LENGTH OF S-WEB-CODE TO UUI000
CALL UUPPSPAD USING UUI000 S-WEB-CODE BY CONTENT 'UBE' ' '
1060 MOVE LENGTH OF S-WEB-CODE TO UUI000
CALL UUPPSPAD USING UUI000 S-WEB-CODE BY CONTENT 'UAF' ' '
1070 MOVE LOW-VALUE TO MESSAGEU
1080* GET FILEDIV(S-WEB-CODE) EQUAL
MOVE LOW-VALUE TO UURKEY-FILEDIV OF FILEDIVU
STRING S-WEB-CODE DELIMITED LOW-VALUE INTO UUR-WEB-CODE OF
FILEDIVU
MOVE 'EQUAL' TO UUFIO-PROCESS
PERFORM UUFIO-FILEDIV
MOVE UUFIO-STATUS TO FILEDIV-UUFIO-STATUS
1090 IF FILEDIV NOT = 'FOUND'
1100 MOVE LOW-VALUE TO S-EDI-OVERRIDE
1110 STRING
'NO DETAILS FOUND. PLEASE TRY AGAIN OR USE INSERTION FACIL
- 'ITY' UUNULLS DELIMITED SIZE INTO MESSAGEU
1120 ELSE
1130* GET FILEDIV(S-WEB-CODE) EQUAL
MOVE LOW-VALUE TO UURKEY-FILEDIV OF FILEDIVU
STRING S-WEB-CODE DELIMITED LOW-VALUE INTO UUR-WEB-CODE OF
FILEDIVU
MOVE 'EQUAL' TO UUFIO-PROCESS
PERFORM UUFIO-FILEDIV
MOVE UUFIO-STATUS TO FILEDIV-UUFIO-STATUS
1140*CHAIN 'EXPLIA2' LOGID SDATE WEB-CODE
*???CHECK EXTERNAL NAME (IN UUPXEXIT):
MOVE 'EXPLIA2' TO UUPROGNAM MOVE 1 TO UUI000
STRING LOGID SDATE WEB-CODE
DELIMITED SIZE
INTO UURMCOMAREA POINTER UUI000 ADD -1 TO UUI000
GO TO UUPROGRAM-EXIT
1150 END-IF
1160*
.
1180*
/++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*
ERROR-MAP SECTION.
* SEGMENTED RETURN LABEL INTO STACK:
PERFORM UUPSEGLABEL-STACK
1220 STRING MESSAGEU ' - INFORM XXX MAINTENANCE IMMEDIATELY'
DELIMITED LOW-VALUE UUNULLS DELIMITED SIZE INTO MESSAGEU
1230 CALL UUATRSET USING UUMX-SCREIA1 UUMC-SCREIA1 UUALARM BY
CONTENT '000' ' ' 'PRO/'
1240 MOVE UUMI-MESSAGEU OF UUMX-SCREIA1 TO UUN333
CALL UUATRSET USING UUMX-SCREIA1 UUMC-SCREIA1 UUALARM BY
CONTENT UUN333 'T' 'RED/'
.
PERFORM UNTIL NOT ( UUI000 = UUI000 )
1260* CONVERSE MAP UPDATE
ADD 1 TO UUMCONVI
MOVE MAP-UUMCTRL TO UUMCTRL(UUMCONVI)
PERFORM UUMAP-CONVERSE
MOVE UUREPLY TO MAP-UUREPLY
1270 END-PERFORM
.
1280
1290*
/++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*
UNLOCK-FILEDIV SECTION.
1330* GET FILEDIV('000000') EQUAL
MOVE LOW-VALUE TO UURKEY-FILEDIV OF FILEDIVU
STRING '000000' DELIMITED LOW-VALUE INTO UUR-WEB-CODE OF
FILEDIVU
MOVE 'EQUAL' TO UUFIO-PROCESS
PERFORM UUFIO-FILEDIV
MOVE UUFIO-STATUS TO FILEDIV-UUFIO-STATUS
1340 IF FILEDIV NOT = 'FOUND'
1350 STRING 'ERROR UNLOCKING FILEDIV' UUNULLS DELIMITED SIZE
INTO MESSAGEU
1360 PERFORM ERROR-MAP
1370 END-IF
1380 MOVE LOW-VALUE TO USER-STAMP
1390 MOVE LOW-VALUE TO DATE-STAMP
1400 MOVE LOW-VALUE TO TIME-STAMP
1410* UPDATE FILEDIV
MOVE 'UPDATE' TO UUFIO-PROCESS
PERFORM UUFIO-FILEDIV
MOVE UUFIO-STATUS TO FILEDIV-UUFIO-STATUS
.
1430*
/++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*
HOUSEKEEPING SECTION.
1470*
* SCREEN / MAP
INITIALIZE MAP-UUREPLY
MOVE 'SCREIA1' TO MAP-UUMAPNAME
MOVE 'SCREI1M' TO MAP-UUBMSNAME
*
1490*
1510*
1530*
1570*
1610 MOVE 6 TO N6
1620*
STRING 'INTF' UUNULLS DELIMITED SIZE INTO INTF-SUBNAME
1640 STRING 'SEUID' UUNULLS DELIMITED SIZE INTO INTF-RESNAME
PERFORM UUCALL-INTF-INTFAC
MOVE UULSTAT TO INTF
1660 MOVE INTF-USBUFAREA(1:5) TO SECTIONU
1670 MOVE INTF-USBUFAREA(17:4) TO LOGID
1680 PERFORM UUGET-DATE
STRING '20' UUDATE(1:2) UUDATE(4:2) UUDATE(7:2) DELIMITED
LOW-VALUE UUNULLS DELIMITED SIZE INTO TODAY
1690 PERFORM UUGET-TIME
MOVE UUTIME TO STIME
1700*
.
/*****************************************************************
* *
* AUXILIARY SECTIONS - MAP/FILE RECORD EDITINGS *
* *
******************************************************************
* MAP EDITING ROUTINES
UUMEDIT-BEFORE SECTION.
EVALUATE UUMEDITNAM
WHEN 'SCREIA1'
PERFORM UUMBEF-SCREIA1
WHEN OTHER
MOVE 'UUPERROR' TO UUPROGNAM
MOVE SPACE TO UUERRORMSG
STRING 'UNKNOWN MAP-EDITS: ' UUMEDITNAM DELIMITED SIZE
INTO UUERRORMSG
GO TO UUEXIT
END-EVALUATE
.
UUMEDIT-AFTER SECTION.
EVALUATE UUMEDITNAM
WHEN 'SCREIA1'
PERFORM UUMAFT-SCREIA1
END-EVALUATE
.
UUMEDIT-CLEAR SECTION.
EVALUATE UUMEDITNAM
WHEN 'SCREIA1'
PERFORM UUMCLR-SCREIA1
END-EVALUATE
.
*---MAP/SCREIA1/SCREI1M------------------------------------------*
COPY SCREI1ME REPLACING ==(P)== BY ====.
/ FILE/INTERFACE EDITING ROUTINES
*---INTF/INTFAC/IIMP---------------------------------------------*
COPY INTFACE REPLACING ==(P)== BY ==INTF-==
==(LVL)== BY ====
==(LVA)== BY ==(UUI000)==.
/---FILEDIV/FILEDIV/FILEDIV--------------------------------------*
COPY FILEDIE REPLACING ==(P)== BY ====
==(LVL)== BY ====
==(LVA)== BY ==(UUI000)==.
/*****************************************************************
* *
* COMMON SYSTEM ROUTINES *
* *
******************************************************************
*---SEGMENTED LABEL UN/STACKING----------------------------------*
COPY UUPXSTAC.
*---MAP CONVERSE-------------------------------------------------*
COPY UUPXCONV.
/---DATE/TIME----------------------------------------------------*
COPY UUPXDATI.
/---CALL/LINK----------------------------------------------------*
COPY UUPXLINK.
/---INPUT/OUTPUT/STATUS------------------------------------------*
COPY UUPXFINO.
** END OF PROGRAM **