Miscellaneous
Use a tool to generate/migrate screens from Natural to CICS
Last update: 7 June 2005
Problem:
I sounds crazy but........some companies want to go back into the future and generate CICS screens (3GL) from Natural maps (4GL).
Solution:
Sent by Marcelo Eugenio Shulman, Buenos Aires:
BMS map source generator
Coding BMS maps is a very tedious process in which you have
to design the layout (usually on a sheet of paper) to get the
columns and then do the BMS coding. The following Assembler program was
written to eliminate the BMS coding. The map image is entered
into an 80-column input file and a batch program is executed to
generate the code as an 80-column output file, which could be
directly compiled using the Assembler.
The following characters have a special meaning in the
program:
-
^ The field has an unprotected attribute. The cursor is
initially at this position.
-
\ The field has a protected attribute.
-
$ The field has an unprotected attribute.
-
~ The field has an unprotected and bright attribute.
-
{ The field has a protected and bright attribute.
-
} End of field marker (required for all fields).
-
9 The field is a numeric field.
These special characters could be changed depending on your
own installation's requirements.
The input should be a maximum of 25 8-column cards, where
the first card should be the mapset name of the map and the
next 24 cards are the map image. If more than 25 cards are
input, the remaining ones are ignored, also a field without '}'
(end of field marker) will be ignored. Figure 1 shows an
example of the input.
BMS CODE GENERATED
MAPSET DFHMSD TYPE=&SYSPARM,MODE=INOUT,LANG=COBOL,STORAGE=AUTO, *
TIOAPFX=YES
MAP001 DFHMDI SIZE=(24,80),CTRL=(FREEKB,FRSET),DATA=FIELD
FLD0001 DFHMDF POS=(01,02),LENGTH=05 *
ATTRB=(FSET), *
INITIAL='PROG1'
FLD0002 DFHMDF POS=(01,39),LENGTH=15, *
ATTRB=(FSET,ASKIP,BRT), *
INITIAL='ABC CORPORATION'
FLD0003 DFHMDF POS=(01,71),LENGTH=08, *
ATTRB=(FSET), *
INITIAL='MM/DD/YY'
FLD0004 DFHMDF POS=(02,02),LENGTH=06, *
ATTRB=(FSET), *
INITIAL='MAP001'
FLD0005 DFHMDF POS=(02,36),LENGTH=09, *
ATTRB=(FSET,ASKIP,BRT), *
INITIAL='MAIN MENU'
FLD0006 DFHMDF POS=(02,71),LENGTH=08, *
ATTRB=(FSET), *
INITIAL='HH:MM:SS'
FLD0007 DFHMDF POS=(05,20),LENGTH=32, *
ATTRB=(FSET), *
INITIAL='1. DISPLAY CUSTOMER INFORMATION'
FLD0008 DFHMDF POS=(06,20),LENGTH=30, *
ATTRB=(FSET), *
INITIAL='2. DISPLAY ORDERS BY CUSTOMER'
FLD0009 DFHMDF POS=(07,20),LENGTH=33, *
ATTRB=(FSET), *
INITIAL='3. DISPLAY PRODUCTS BY PROD CODE'
FLD0010 DFHMDF POS=(08,20),LENGTH=20, *
ATTRB=(FSET), *
INITIAL='4. EXIT/QUIT SYSTEM'
FLD0011 DFHMDF POS=(11,02),LENGTH=78, *
ATTRB=(FSET), *
INITIAL='-----------------------------------------------*
-------------------------------'
FLD0012 DFHMDF POS=(13,02),LENGTH=08, *
ATTRB=(FSET), *
INITIAL='OPTION :'
FLD0013 DFHMDF POS=(13,12),LENGTH=01, *
ATTRB=(FSET,UNPROT,NUM,IC), *
INITIAL='9'
DFHMDF POS=(13,14),LENGTH=01,ATTRB=(FSET,ASKIP)
FLD0014 DFHMDF POS=(15,02),LENGTH=38, *
ATTRB=(FSET,UNPROT,BRT), *
INITIAL='XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
DFHMDF POS=(15,41),LENGTH=01,ATTRB=(FSET,ASKIP)
DFHMSD TYPE=FINAL
END
SOURCE CODE FOR GENMAP -- Sydney Salvo (Philippines)-- c Xephon 1992
GENMAP START 0
SAVE (14,12)
BEGIN BALR R11,0
USING *,R11
ST R13,SAVEAREA+4
LA R13,SAVEAREA
OPEN (CARDIN,(INPUT))
OPEN (CARDOT,(OUTPUT))
ZAP LINE,=P'0'
B READ
CARDIN DCB DDNAME=CARDIN, *
DSORG=PS, *
MACRF=GM, *
EODAD=EOJ, *
LRECL=80, *
RECFM=FB
CARDOT DCB DDNAME=CARDOT, *
DSORG=PS, *
MACRF=PM, *
RECFM=FB, *
LRECL=80
LTORG
SW1 DC C' '
SW2 DC C' '
SW3 DC C' '
SW4 DC C' '
FLDNO DC PL4'0'
L1 DC PL2'0'
LEN DC PL2'0'
RLEN DC PL2'0'
WRK DC PL2'0'
LINE DC PL2'0'
STR DC PL2'0'
STARTP DC PL2'0'
CDIN DS CL80
OPTION DC PL2'0'
CD1 DS 0CL80
DC C'MAPSET '
DC C'DFHMSD '
DC C'TYPE=&&SYSPARM,MODE=INOUT,LANG=COBOL,STORAGE=AUTO, '
DC C' *'
DC 8C' '
CD2 DS 0CL80
DC 15C' '
DC C'TIOAPFX=YES'
DC 54C' '
CD3 DS 0CL80
DC 9C' '
DC C'DFHMDI '
DC C'SIZE=(24,80),CTRL=(FREEKB,FRSET),DATA=FIELD'
DC 21C' '
CD4A DS 0CL80
DC C'FLD'
NO4A DC C'0000'
DC 2C' '
DC C'DFHMDF '
DC C'POS=('
LI4A DC C'00'
DC C','
ST4A DC C'00'
DC C'),'
DC C'LENGTH='
LE4A DC C'00'
DC C','
DC 33C' '
DC C'*'
DC 8C' '
CD4B DS 0CL80
DC 15C' '
DC C'ATTRB=(FSET'
OPT4B DC 45C' '
DC C'*'
DC 8C' '
CD4C DS 0CL80
DC 15C' '
DC C'INITIAL='
DC X'7D'
CD4CI DC 47C' '
CD4CA DC C'*'
DC 8C' '
CD4D DS 0CL80
DC 15C' '
CD4DI DC 65C' '
CD5 DS 0CL80
DC 9C' '
DC C'DFHMDF '
DC C'POS=('
LI5 DC C'00'
DC C','
ST5 DC C'00'
DC C'),'
DC C'LENGTH='
DC C'01'
DC C','
DC C'ATTRB=(FSET,ASKIP)'
DC 47C' '
CD7 DS 0CL80
DC 9C' '
DC C'DFHMSD '
DC C'TYPE=FINAL'
DC 54C' '
CD9 DS 0CL80
DC 9C' '
DC C'END'
DC 68C' '
FLD0 DS 0CL80
FLD01 DC 47C' '
FLD9 DS 0CL65
FLD02 DC 33C' '
DC C' '
DC 31C' '
OPTIONS DS 10CL45
OPT1 DC CL45',UNPROT),'
OPT2 DC CL45',UNPROT,NUM),'
OPT3 DC CL45',ASKIP,NUM),'
OPT4 DC CL45'),'
OPT11 DC CL45',UNPROT,BRT),'
OPT21 DC CL45',UNPROT,NUM,BRT),'
OPT31 DC CL45',ASKIP,NUM,BRT),'
OPT41 DC CL45',ASKIP,BRT),'
OPT12 DC CL45',UNPROT,IC),'
OPT22 DC CL45',UNPROT,NUM,IC),'
SAVEAREA DS 18F
READ GET CARDIN,CDIN
LA R6,CDIN-1
CLI SW1,C' '
BE FIRST
ZAP STR,=P'1'
AP LINE,=P'1'
CP LINE,=P'24'
BH READ
ZAP LEN,=P'0'
ZAP RLEN,=P'0'
ZAP L1,=P'0'
MVI SW2,C' '
MVI SW3,C' '
MVI SW4,C' '
LA R7,FLD0
MVC 0(80,R7),=80C' '
CHECK EQU *
LA R6,1(,R6)
AP L1,=P'1'
AP STR,=P'1'
CP L1,=P'80'
BH READ
CLI 0(R6),C'}'
BE OUTCD
CLI 0(R6),C'^'
BE CUR
CLI 0(R6),C'\'
BE PROT
CLI 0(R6),C'$'
BE UNPROT
CLI 0(R6),C'~'
BE UPRTBRT
CLI 0(R6),C'{'
BE PRTBRT
CLI 0(R6),C' '
BE CHECK2
CONT1 EQU *
CLI SW2,C' '
BE NXTCHR
CONT EQU *
MVI SW2,C'Y'
AP LEN,=P'1'
AP RLEN,=P'1'
MVC 0(1,R7),0(R6)
LA R7,1(,R7)
CLI 0(R6),X'50'
BE RPTMV1
CLI 0(R6),X'7D'
BE RPTMV2
B CHECK
RPTMV1 EQU *
MVI 0(R7),X'50'
LA R7,1(,R7)
AP LEN,=P'1'
B CHECK
RTPMV2 EQU *
MVI 0(R7),X'7D'
LA R7,1(,R7)
AP LEN,=P'1'
B CHECK
CHECK2 EQU *
CLI SW4,C'Y'
BE CONT
B CHECK
CUR EQU *
ZAP STARTP,STR
MVI SW3,C'Y'
AP OPTION,=P'24'
B CHECK
PROT EQU *
ZAP STARTP,STR
MVI SW3,C' '
AP OPTION,=P'0'
B CHECK
UNPROT EQU *
ZAP STARTP,STR
MVI SW3,C'Y'
AP OPTION,=P'8'
B CHECK
UPRTBRT EQU *
ZAP STARTP,STR
MVI SW3,C'Y'
AP OPTION,=P'40'
B CHECK
PRTBRT EQU *
ZAP STARTP,STR
MVI SW3,C' '
AP OPTION,=P'32'
B CHECK
NXTCHR EQU *
MVI SW4,C'Y'
CLI 0(R6),C'9'
BNE CONT
AP OPTION,=P'2'
B CONT
OUTCD EQU *
MVI 0(R7),X'7D'
MVI SW2,C' '
MVI SW4,C' '
CP RLEN,=P'0'
BE CHECK
MVN FLDNO+3(1),=X'FF'
MVN LINE+1(1),=X'FF'
MVN RLEN+1(1),=X'FF'
MVN STARTP+1(1),=X'FF'
UNPK NO4A,FLDNO
UNPK ST4A,STARTP
UNPK LE4A,RLEN
UNPK LI4A,LINE
AP FLDNO,=P'1'
OUTCD4A EQU *
PUT CARDOT,CD4A
CP OPTION,=P'2'
BE MOPT3
CP OPTION,=P'8'
BE MOPT1
CP OPTION,=P'10'
BE MOPT2
CP OPTION,=P'24'
BE MOPT12
CP OPTION,=P'26'
BE MOPT22
CP OPTION,=P'40'
BE MOPT11
CP OPTION,=P'42'
BE MOPT21
CP OPTION,=P'34'
BE MOPT31
CP OPTION,=P'32'
BE MOPT41
MVC OPT4B(39),OPT4
OUTCD4B EQU *
PUT CARDOT,CD4B
ZAP OPTION,=P'0'
MVC CD4CI(47),FLD01
CP LEN,=P'46'
BH MORE47
MVI CD4CA,C' '
OUTCD4C EQU *
PUT CARDOT,CD4C
LA R7,FLD0
MVC 0(80,R7),=80C' '
OUTCD5 EQU *
ZAP WRK,RLEN
ZAP RLEN,=P'0'
ZAP LEN,=P'0'
MVC FLD0(80),=80C' '
CLI SW3,C' '
BE CHECK
CP STR,=P'79'
BH CHECK
AP WRK,STARTP
AP WRK,=P'1'
MVN WRK+1(1),=X'FF'
MVN LINE+1(1),=X'FF'
UNPK ST5,WRK
UNPK LI5,LINE
PUT CARDOT,CD5
B CHECK
MORE47 EQU *
MVI CD4CA,C'*'
PUT CARDOT,CD4C
MVC CD4DI(34),FLD9
PUT CARDOT,CD4D
B OUTCD5
MOPT41 EQU *
MVC OPT4B(39),OPT41
B OUTCD4B
MOPT31 EQU *
MVC OPT4B(39),OPT31
B OUTCD4B
MOPT21 EQU *
MVC OPT4B(39),OPT21
B OUTCD4B
MOPT11 EQU *
MVC OPT4B(39),OPT11
B OUTCD4B
MOPT12 EQU *
MVC OPT4B(39),OPT12
B OUTCD4B
MOPT22 EQU *
MVC OPT4B(39),OPT22
B OUTCD4B
MOPT1 EQU *
MVC OPT4B(39),OPT1
B OUTCD4B
MOPT2 EQU *
MVC OPT4B(39),OPT2
B OUTCD4B
MOPT3 EQU *
MVC OPT4B(39),OPT3
B OUTCD4B
FIRST EQU *
CLI 1(R6),C'*'
BE READ
MVI SW1,C'Y'
ZAP FLDNO,=P'1'
PUT CARDOT,CD1
PUT CARDOT,CD2
MVC CD3(7),1(R6)
PUT CARDOT,CD3
B READ
EOJ EQU *
PUT CARDOT,CD7
PUT CARDOT,CD9
CLOSE CARDIN
CLOSE CARDOT
L R13,SAVEAREA+4
RETURN (14,12),RC=0
END
|
MISCELLANEOUS Tips, Tricks, Techniques -- Overview
Top Page