| KICKS |
A transaction processing system for CMS & TSO |
Designing and implementing simple KICKS COBOL programs
Last time you saw how to prepare, generate and use simple KICKS BMS maps. This time you will build on that to start designing, compiling and using simple KICKS COBOL programs that use such maps.
What better place to begin than the first screen you see when you startup KICKS!
KSGM is the KICKS 'good morning' message program usually seen when KICKS starts. Of course you know how it works – press any key except clear and the colors of the letters change; but press clear and the transaction is gone; you are at a blank screen ready to enter your next transaction. Seem simple enough, so let’s start with the map.
The mapset we will use is a cut down version of the one KSGM uses. KSGM uses different maps for different screen geometries, but that's a topic for another day. Today's mapset has only a single 24x80 map.
TESTMSD DFHMSD MODE=INOUT,CTRL=FREEKB, *DSATTS=(COLOR),MAPATTS=(COLOR), *TYPE=&SYSPARM,LANG=COBOL,TIOAPFX=YES*TESTMAP DFHMDI SIZE=(24,80),COLOR=TURQUOISE*MAPX01 DFHMDF POS=(01,01),LENGTH=17,INITIAL='KSGM for tso user'MAPA01 DFHMDF POS=(01,19),LENGTH=08,ATTRB=ASKIPDFHMDF POS=(01,28),LENGTH=11,INITIAL='at terminal'MAPB01 DFHMDF POS=(01,40),LENGTH=08,ATTRB=ASKIPMAPC01 DFHMDF POS=(01,59),LENGTH=08,ATTRB=ASKIPMAPD01 DFHMDF POS=(01,69),LENGTH=08,ATTRB=ASKIPMAPE01 DFHMDF POS=(01,50),LENGTH=08,ATTRB=ASKIP*MAPA06 DFHMDF POS=(06,12),LENGTH=12,INITIAL='KK KK'MAPB06 DFHMDF POS=(06,27),LENGTH=10,INITIAL='IIIIIIIIII'MAPC06 DFHMDF POS=(06,41),LENGTH=10,INITIAL='CCCCCCCCCC'MAPD06 DFHMDF POS=(06,54),LENGTH=12,INITIAL='KK KK'MAPE06 DFHMDF POS=(06,69),LENGTH=10,INITIAL='SSSSSSSSSS'*MAPA07 DFHMDF POS=(07,11),LENGTH=11,INITIAL='KK KK'MAPB07 DFHMDF POS=(07,26),LENGTH=10,INITIAL='IIIIIIIIII'MAPC07 DFHMDF POS=(07,39),LENGTH=12,INITIAL='CCCCCCCCCCCC'MAPD07 DFHMDF POS=(07,53),LENGTH=11,INITIAL='KK KK'MAPE07 DFHMDF POS=(07,67),LENGTH=12,INITIAL='SSSSSSSSSSSS'*MAPA08 DFHMDF POS=(08,10),LENGTH=10,INITIAL='KK KK'MAPB08 DFHMDF POS=(08,29),LENGTH=02,INITIAL='II'MAPC08 DFHMDF POS=(08,38),LENGTH=12,INITIAL='CC CC'MAPD08 DFHMDF POS=(08,52),LENGTH=10,INITIAL='KK KK'MAPE08 DFHMDF POS=(08,66),LENGTH=12,INITIAL='SS SS'*MAPA09 DFHMDF POS=(09,09),LENGTH=09,INITIAL='KK KK'MAPB09 DFHMDF POS=(09,28),LENGTH=02,INITIAL='II'MAPC09 DFHMDF POS=(09,37),LENGTH=02,INITIAL='CC'MAPD09 DFHMDF POS=(09,51),LENGTH=09,INITIAL='KK KK'MAPE09 DFHMDF POS=(09,65),LENGTH=02,INITIAL='SS'*MAPA10 DFHMDF POS=(10,08),LENGTH=08,INITIAL='KK KK'MAPB10 DFHMDF POS=(10,27),LENGTH=02,INITIAL='II'MAPC10 DFHMDF POS=(10,36),LENGTH=02,INITIAL='CC'MAPD10 DFHMDF POS=(10,50),LENGTH=08,INITIAL='KK KK'MAPE10 DFHMDF POS=(10,64),LENGTH=03,INITIAL='SSS'*MAPA11 DFHMDF POS=(11,07),LENGTH=07,INITIAL='KKKKKKK'MAPB11 DFHMDF POS=(11,26),LENGTH=02,INITIAL='II'MAPC11 DFHMDF POS=(11,35),LENGTH=02,INITIAL='CC'MAPD11 DFHMDF POS=(11,49),LENGTH=07,INITIAL='KKKKKKK'MAPE11 DFHMDF POS=(11,64),LENGTH=09,INITIAL='SSSSSSSSS'MAPF11 DFHMDF POS=(11,40),LENGTH=04,INITIAL=' '*MAPA12 DFHMDF POS=(12,06),LENGTH=07,INITIAL='KKKKKKK'MAPB12 DFHMDF POS=(12,25),LENGTH=02,INITIAL='II'MAPC12 DFHMDF POS=(12,34),LENGTH=02,INITIAL='CC'MAPD12 DFHMDF POS=(12,48),LENGTH=07,INITIAL='KKKKKKK'MAPE12 DFHMDF POS=(12,64),LENGTH=09,INITIAL='SSSSSSSSS'*MAPA13 DFHMDF POS=(13,05),LENGTH=08,INITIAL='KK KK'MAPB13 DFHMDF POS=(13,24),LENGTH=02,INITIAL='II'MAPC13 DFHMDF POS=(13,33),LENGTH=02,INITIAL='CC'MAPD13 DFHMDF POS=(13,47),LENGTH=08,INITIAL='KK KK'MAPE13 DFHMDF POS=(13,70),LENGTH=03,INITIAL='SSS'*MAPA14 DFHMDF POS=(14,04),LENGTH=09,INITIAL='KK KK'MAPB14 DFHMDF POS=(14,23),LENGTH=02,INITIAL='II'MAPC14 DFHMDF POS=(14,32),LENGTH=02,INITIAL='CC'MAPD14 DFHMDF POS=(14,46),LENGTH=09,INITIAL='KK KK'MAPE14 DFHMDF POS=(14,70),LENGTH=02,INITIAL='SS'*MAPA15 DFHMDF POS=(15,03),LENGTH=10,INITIAL='KK KK'MAPB15 DFHMDF POS=(15,22),LENGTH=02,INITIAL='II'MAPC15 DFHMDF POS=(15,31),LENGTH=12,INITIAL='CC CC'MAPD15 DFHMDF POS=(15,45),LENGTH=10,INITIAL='KK KK'MAPE15 DFHMDF POS=(15,59),LENGTH=12,INITIAL='SS SS'*MAPA16 DFHMDF POS=(16,02),LENGTH=11,INITIAL='KK KK'MAPB16 DFHMDF POS=(16,17),LENGTH=10,INITIAL='IIIIIIIIII'MAPC16 DFHMDF POS=(16,30),LENGTH=12,INITIAL='CCCCCCCCCCCC'MAPD16 DFHMDF POS=(16,44),LENGTH=11,INITIAL='KK KK'MAPE16 DFHMDF POS=(16,59),LENGTH=12,INITIAL='SSSSSSSSSSSS'*MAPA17 DFHMDF POS=(17,01),LENGTH=12,INITIAL='KK KK'MAPB17 DFHMDF POS=(17,16),LENGTH=10,INITIAL='IIIIIIIIII'MAPC17 DFHMDF POS=(17,30),LENGTH=11,INITIAL='CCCCCCCCCCC'MAPD17 DFHMDF POS=(17,43),LENGTH=12,INITIAL='KK KK'MAPE17 DFHMDF POS=(17,59),LENGTH=10,INITIAL='SSSSSSSSSS'*MAPA18 DFHMDF POS=(18,70),LENGTH=2,INITIAL='TM',COLOR=RED*MAPA20 DFHMDF POS=(20,60),LENGTH=18,INITIAL='For TSO ', *COLOR=NEUTRALMAPB20 DFHMDF POS=(22,60),LENGTH=06,INITIAL='V1R5M0'MAPC20 DFHMDF POS=(23,60),LENGTH=16,INITIAL='September 2014 'DFHMDF POS=(24,01),LENGTH=40, *INITIAL='Press PF1 for help, CLEAR to continue...'DFHMDF POS=(24,42),LENGTH=02,ATTRB=(IC)DFHMDF POS=(24,60),LENGTH=11,INITIAL='© Mike Noel'*DFHMSD TYPE=FINALEND
There are only a few things to talk about and we won’t need to go through it line-by-line. We just need to understand it well enough to write some code to use it.
Probably the first thing you notice is that the map statements are DFHMSD, DFHMDI, DFHMDF instead of KIKMSD, KIKMDI, and KIKMDF. CICS used the ‘DFH’ prefix everywhere, so where it makes sense KICKS uses a corresponding ‘KIK’ prefix, but both the map generator program and the preprocessor programs can automatically translate any ‘DFH’s they find into ‘KIK’s. Use whichever you like. CICS will insist on ‘DFH’s so if you move maps or programs back and forth you could stick with those ‘DFH’s so that you don’t have to change back and forth – or – if you want to make sure you keep “what belongs where” straight – use ‘KIK’s for your KICKS components and ‘DFH’s for your CICS components.
You’ll also notice DSATTS=(COLOR) and MAPATTS=(COLOR) on the DFHMSD statement. This tells the map generator to build the map to support color highlighting.
You’re also sure to notice the DFHMSD continuation “TYPE=&SYSPARM,LANG=COBOL,TIOAPFX=YES”. This actually does nothing at all for KICKS – but it’s a really good idea to include it in all your maps because you will need it if you want to use the map with CICS.
Moving down the screen your eye will probably catch the funny field names. Of course field names can be anything you like (up to seven characters) but when there are MANY fields defined it helps if the fields are named with a convention. The naming convention in this map is MAPXYY where X varies across the screen as A, B, C, D, … and YY varies down the screen as 01, 02, 03, … Comparing the screen shot at the top to the first few fields in the map you can see that the field MAPA01 is the tso userid, the field MAPD01 is the date, etc. You also observed those fields have ATTRB=ASKIP, which means input can’t be entered in those fields and the tab key won’t get the cursor to them.
Moving further down the screen the A-E fields for lines 6-17 are the large colored ‘KICKS’ letters – the ‘A’s are the first K, the ‘B’s are the I, and so on. You might wonder, since they are so prominently colored on the screen, why there is no color specified in the map? The answer is that the program that sends the map will add the color at run time! Another point: the map is arranged left to right, top to bottom. It doesn’t have to be. For example it might be easier for you if at least part of it was arranged top to bottom, left to right, so that the ‘letters’ part was arranged to make the appearance more clear, as in this snippet of the first ‘K’ .
MAPA06 KIKMDF POS=(06,12),LENGTH=12,INITIAL='KK KK'MAPA07 KIKMDF POS=(07,11),LENGTH=11,INITIAL='KK KK'MAPA08 KIKMDF POS=(08,10),LENGTH=10,INITIAL='KK KK'MAPA09 KIKMDF POS=(09,09),LENGTH=09,INITIAL='KK KK'MAPA10 KIKMDF POS=(10,08),LENGTH=08,INITIAL='KK KK'MAPA11 KIKMDF POS=(11,07),LENGTH=07,INITIAL='KKKKKKK'MAPA12 KIKMDF POS=(12,06),LENGTH=07,INITIAL='KKKKKKK'MAPA13 KIKMDF POS=(13,05),LENGTH=08,INITIAL='KK KK'MAPA14 KIKMDF POS=(14,04),LENGTH=09,INITIAL='KK KK'MAPA15 KIKMDF POS=(15,03),LENGTH=10,INITIAL='KK KK'MAPA16 KIKMDF POS=(16,02),LENGTH=11,INITIAL='KK KK'MAPA17 KIKMDF POS=(17,01),LENGTH=12,INITIAL='KK KK'
The physical sequence does not affect the ‘tab sequence’ (the order of fields covered as the tab key is pressed) and none of the big letter fields are for input anyway; as we will see the only reason they are named is to allow their attributes to be modified.
The bottom of the screen has a few more fields, including some with static color and highlighting, but nothing we need to spend more time on. Just a reminder: we need to compile the map before we can use it. As discussed in earlier KooKbooK recipes you use the KIKMAPS proc in TSO,
//MAP JOB//JOBPROC DD DSN=USERID.KICKSSYS.V1R5M0.PROCLIB,DISP=SHR<< Legacy MVS //JOBPROC JCLLIB ORDER=(USERID.KICKSSYS.V1R5M0.PROCLIBZ)<< Z/OS // EXEC KIKMAPS,MAPNAME=TESTMSD//COPY.SYSUT1 DD *... map source as above .../*
or the KIKMG exec in CMS.
KIKMG TESTMSD
And as before when your map is compiled you can test it with a simple COBOL program, as below
ID DIVISION.PROGRAM-ID. TESTCOB.DATA DIVISION.WORKING-STORAGE SECTION.COPY TESTMSD.PROCEDURE DIVISION.EXEC CICSSEND MAP('TESTMAP') MAPSET('TESTMSD') ERASEEND-EXEC.EXEC CICS RETURN END-EXEC.
Compilng this in TSO you use the KICKS compile proc (K2KCOBCL in legacy MVS, or KIKCB2CL in Z/OS).
//PROGRAM JOB//JOBPROC DD DSN=USERID.KICKSSYS.V1R5M0.PROCLIB,DISP=SHR<< Legacy MVS //JOBPROC JCLLIB ORDER=(USERID.KICKSSYS.V1R5M0.PROCLIBZ)<< Z/OS // EXEC K2KCOBCL (or KIKCB2CL in Z/OS)//COPY.SYSUT1 DD *... COBOL source as above .../*//LKED.SYSIN DD *INCLUDE SKIKLOAD(KIKCOBGL)ENTRY TESTCOBNAME TESTCOB(R)
Or in CMS
K2KCOBCL TESTCOB<< VM/370 or
KIKCB2CL TESTCOB<< Z/VM
You might notice that this uses ‘EXEC CICS’ instead of the ‘EXEC KICKS’ used before. The COBOL preprocessor program automatically translates any ‘EXEC CICS’s it finds into ‘EXEC KICK’s. Use whichever you like. CICS will insist on ‘EXEC CICS’ so if you move maps or programs back and forth you could stick with those ‘EXEC CICS’s so that you don’t have to change back and forth – or – if you want to make sure you keep “what belongs where” straight – use ‘EXEC KICK’s for your KICKS programs and ‘EXEC CICS’s for your CICS programs.
This time when the transaction is run by starting KICKS and typing TCOB on a clear screen, the result is as at the top of this page, EXCEPT only the bare map is displayed with none of the fields filled and with the block letters in default color (same color as the rest of the text on the screen). And the APCT abend is still there as soon as you press enter. Time to get busy fixing those things.
Let’s start with the APCT abend. It occurs because the program has ended, so when you press enter it is KICKS itself that processes the input, and it expect that input to be the name of the next transaction to run. When what it gets does not match any transaction name it throws an APCT abend. There are a variety of ways to fix this; some of them are:
Actually the first is already being done; the bottom line of the screen says “Press CLEAR to continue…”. But let’s assume this isn’t sufficient.
How can we arrange for the screen to be cleared for the user? We could make HIM to do it by quitting only after he presses CLEAR and ignoring anything else he types – like this.
ID DIVISION.PROGRAM-ID. TESTCOB.DATA DIVISION.WORKING-STORAGE SECTION.COPY TESTMSD.COPY DFHAID.++ PROCEDURE DIVISION.RESEND-IT.++ EXEC CICSSEND MAP('TESTMAP') MAPSET('TESTMSD') ERASEEND-EXEC.EXEC CICS++ RECEIVE MAP('TESTMAP') MAPSET('TESTMSD') NOHANDLE++ END-EXEC.++ IF EIBAID NOT = DFHCLEAR GO TO RESEND-IT.++ EXEC CICS RETURN END-EXEC.
The logic is to not immediately end, but rather to read the user’s input, and if it is anything other than the CLEAR key to simply re-send the map and wait till he does something else. Eventually (we hope) he will press CLEAR and the program will end with the screen clear for entry of the next transaction.
We’ve seen the RECEIVE MAP before, and the check for CLEAR and the looping back is pretty obvious, but what is the NOHANDLE, or that new copybook DFHAID, or EIBAID?
NOHANDLE is an optional argument of most of EXEC CICS calls. If present KICKS will provide feedback about call failures in the EIBRESP AND EIBRESP2 variables instead of abending. We need to use NOHANDLE here because terminating a RECEIVE MAP by clearing the screen will result in an AEI9 (mapfail) abend that we must trap.
DFHAID (KIKAID really – remember the preprocessor will change the name before the copy really happens) is a list of 3270 aid key values used so you can mnemonically test to see what key the user pressed. DFHCLEAR (KIKCLEAR really – remember the preprocessor) is the value for the CLEAR key. A few of the many other values defined are DFHENTER for the ENTER key, DFHPF1 for the PF1 key, and DFHPA1 for the PA1 key.
EIBAID is the value of the 3270 aid key that the user actually pressed during the preceding RECEIVE MAP.
You probably noticed EIBAID isn’t in the listing (except for the IF test) and it’s not in the KIKAID copy book either. EIBAID and the afore mentioned EIBRESP and EIBRESP2 are fields of the EIB (Exec Interface Block) mapped by copy book KIKEIB. The preprocessor adds a copy for the KIKEIB copy book to the LINKAGE SECTION of your program (and creates a LINKAGE SECTION if necessary) and (like CICS) the EIB is always the first argument of the USING clause the KICKS processor adds to your program’s PROCEDURE DIVISION statement. There is no ‘KIK’ or ‘DFH’ in the EIB field names, they are the same in CICS and KICKS, but not all fields are present in both, and not all the common fields are defined exactly the same way or mean exactly the same thing. The EIB structure (arrangement of fields) is completely different between CICS and KICKS.
The new program does eliminate the APCT abend problem. BUT – if you’ve ever written a real CICS application – you’re probably jumping up and down screaming about this being CONVERSATIONAL. The standards guys at most shops will never let you put a conversational transaction into a production CICS region. It’s almost like conversational is another name for evil.
What does it mean for a transaction to be conversational? A conversational transaction is one that holds its resources during the user’s think time. That’s bad if you have thousands of users holding resources while they don’t really need to, and that’s why very few CICS transactions do it. The alternative is a PSEUDO‑CONVERSATIONAL transaction which releases pretty much everything (except some state information) between the SEND MAP and the following RECEIVE MAP. While the practical difference between conversational and pseudo‑conversational is unimportant in a KICKS environment (after all, in KICKS there is only one user!) it’s pretty simple to make your KICKS transactions pseudo‑conversational and doing so will make them much easier to migrate it to the real CICS system if you later decide to do so.
The structure of a conversational transaction is (1) send initial map, then (2) loop with (2a) read map, (2b) do something, (2c) send map, (3) until some terminating condition occurs, then finish.
The structure of a pseudo‑conversational transaction is essentially a similar setup and teardown, but only one pass through the loop. Additional loop passes become repeated automatic invocation of the transaction occurring each time the user presses the ENTER key! Remember we talked about “Arranging the system use some supplied name instead of screen input” to start the next transaction? We are about to see how that’s done.
The first time a pseudo‑conversational transaction is entered it needs to (1) send the initial screen and exit with instructions to return when the user presses ENTER. Thereafter it needs to (2a) read the map, (2b) do something, (2c) send map with instructions to return the next time the user presses enter, or (still 2c) finish if some terminating condition has occurred. Let’s see that in action.
ID DIVISION.PROGRAM-ID. TESTCOB.DATA DIVISION.WORKING-STORAGE SECTION.COPY TESTMSD.COPY DFHAID.PROCEDURE DIVISION.IF EIBCALEN NOT = 0++ EXEC CICS++ RECEIVE MAP('TESTMAP') MAPSET('TESTMSD') NOHANDLE++ END-EXEC++ IF EIBAID = DFHCLEAR++ EXEC CICS RETURN END-EXEC.++ EXEC CICSSEND MAP('TESTMAP') MAPSET('TESTMSD') ERASEEND-EXEC.EXEC CICS RETURN++ TRANSID(EIBTRNID) COMMAREA(MAPA01O)++ END-EXEC.++
There is quite a lot of structure change in our program this time and as intended there is no loop at all…
Let’s look at the top highlighted code group – it’s two IF statements, one nested in the other – with just one period at the end. It’s testing to see if EIBCALEN (an EIB field that tells the length of the inbound COMMAREA – more on what the COMMAREA is in a moment) is non-zero.
When the user starts the transaction by typing ‘TCOB’ there will be no COMMAREA (length will be zero) so this test will be false; the RECEIVE MAP, test for DFHCLEAR, and CICS RETURN will be bypassed.
If the test was false, or if it was true and the MAP was RECEIVE’d but the user did not press clear, SEND MAP puts the image (back) on the screen, and in the lower highlighted code group, an EXEC CICS RETURN takes us back.
But this bottom RETURN is different from the RETURNs we’ve looked at before. This time we’ve included the TRANSID option to tell KICKS that, regardless of what’s on the screen, when the user presses ENTER (or any aid key for that matter) the same transaction id is to be executed again. The transaction id is sometimes coded as a literal, ie, TRANSID('TCOB'), but since almost all transactions end up returning to themselves it can be easier to just code it as above, which will cause a return to the current transaction id regardless of what it happens to be
We also included COMMAREA to pass information to the new transaction. In this case we don’t care what the information is (it's just an 8 character piece of the output map), but the fact that it exists (length not equal zero) will be detected and interpreted to mean that this is not the first time the transaction has been run in this sequence.
The next time the user presses ENTER (or clear, or a pf or pa key) the transaction starts up again, but this time the EIBCALEN test is true (i.e., EIBCALEN = 8, the length of MAPA01O) so the RECEIVE MAP will occur, and the EIBAID test will occur, and if the clear key was pressed a ‘normal’ RETURN (without the TRANSID and COMMAREA) will happen to end the transaction. Otherwise it’s another SEND MAP, and another special RETURN as above.
Since when the user does press the CLEAR key the EXEC CICS RETURN is without the TRANSID and COMMAREA options, the next time that the user enters the ‘TCOB’ transaction from the terminal EIBCALEN will be back to zero and the transaction will behave as we expect, starting by sending the initial screen.
We’ve talked about the transaction ‘starting up’ several times. Of course it starts when the user types ‘TCOB’ and thereafter starts again each time the user presses any aid key, until he’s pressed the clear key to end the sequence. These starts are truly independent. Working-Storage is NOT preserved between them!
The COMMAREA also need a bit more explanation. In the above example we just use it as a flag: if its LENGTH = 0 do one thing, otherwise do something else. But its larger purpose is to provide a way for one independent program to pass information to another. The sending program loads whatever it wants into the COMMAREA, the receiving program can get the information back out. Obviously the programs must agree on what the information is! In our case this was easy since the same program that sent the data was receiving it and the only thing significant about the data was its existence. But suppose we wanted to get the information back out. How would we do that?
It turns out the COMMAREA is like the EIB; it is added to the USING clause of your program by the preprocessor when you code an 01 for KIKCOMMAREA (or DFHCOMMAREA) in its LINKAGE SECTION. So we could add
LINKAGE SECTION.01 DFHCOMMAREA PIC X(8).
And use it (when EIBCALEN = 8) to retrieve what was put there (the return code from the previous RECEIVE MAP, or ?? if no RECEIVE MAP was done – just junk really).
Maybe you see a connection. Working-Storage is not preserved between transactions, but the COMMAREA is. A major use of a COMMAREA is to pass working-storage items that for whatever reason need to be preserved! Suppose we wanted to restore that old userid. All we’d have to do is move DFHCOMMAREA to our working storage area, perhaps like this.
01 WS-COMM.05 MAPA01O PIC X(8).... MOVE DFHCOMMAREA to WS-COMM.
It’s time to stop working with these simpler examples and move on the something closer to the real thing
ID DIVISION.PROGRAM-ID. TESTCOB.ENVIRONMENT DIVISION.DATA DIVISION.WORKING-STORAGE SECTION.77 WS-ABSTIME PIC S9(15) COMP-3.* vars for shuffle-colors01 I PIC S9(8) COMP.01 J PIC S9(8) COMP.01 K PIC S9(8) COMP.01 FILLER REDEFINES K.05 FILLER PIC X(3).05 KX PIC X.* vars for random-number01 IA PIC S9(8) COMP VALUE +13077.01 IM PIC S9(8) COMP VALUE +32768.01 IC PIC S9(8) COMP VALUE +6925.01 FSEED COMP-1.01 FIM COMP-1.01 IRNDM PIC S9(8) COMP.* working storage copy of comm-area01 WS-COMM.05 ISEED PIC S9(8) COMP.05 COLORS OCCURS 5 PIC X.COPY TESTMSD.COPY DFHAIDCOPY DFHBMSCALINKAGE SECTION.01 DFHCOMMAREA PIC X(100).PROCEDURE DIVISION.IF EIBCALEN = 0MOVE DFHDFT TO COLORS (1), COLORS (2), COLORS (3),COLORS (4), COLORS (5)MOVE EIBTIME TO ISEEDELSEIF EIBCALEN NOT = LENGTH OF WS-COMMEXEC CICS ABEND ABCODE('COMM') END-EXECELSEMOVE DFHCOMMAREA TO WS-COMMEXEC CICSRECEIVE MAP('TESTMAP') MAPSET('TESTMSD') NOHANDLEEND-EXECIF EIBAID = DFHCLEAREXEC CICS RETURN END-EXEC.PERFORM FILL-IN-MAP.EXEC CICSSEND MAP('TESTMAP') MAPSET('TESTMSD') ERASEEND-EXEC.EXEC CICSRETURN TRANSID(EIBTRNID) COMMAREA(WS-COMM)END-EXEC.FILL-IN-MAP SECTION.MOVE LOW-VALUES TO TESTMAPO.* FILL IN THE USER IDEXEC CICS ASSIGN USERID(MAPA01O) END-EXEC.* FILL IN THE TERMINAL IDMOVE EIBTRMID TO MAPB01O.* FILL IN THE SYSTEM IDMOVE EIBSYSID TO MAPE01O.* FILL IN THE TIME AND DATE USING ASKTIME/FORMATTIMEEXEC CICS ASKTIME ABSTIME(WS-ABSTIME) END-EXEC.EXEC CICS FORMATTIME ABSTIME(WS-ABSTIME)TIME(MAPC01O) TIMESEP(':')END-EXEC.EXEC CICS FORMATTIME ABSTIME(WS-ABSTIME)MMDDYY(MAPD01O) DATESEP('/')END-EXEC.* COLOR THE BIG LETTERSPERFORM SHUFFLE-COLORS.PERFORM COLOR-LETTERS.FILL-IN-MAP-EXIT.EXIT.SHUFFLE-COLORS SECTION.MOVE +1 TO I.SC-1.IF I > 5 GO TO SHUFFLE-COLORS-EXIT.PERFORM RANDOM-NUMBER.DIVIDE IRNDM BY 7 GIVING J REMAINDER K.ADD +241 TO K.* don't want 2nd K to be red...IF (I = +5) AND (KX = DFHRED) GO TO SC-1.MOVE +1 TO J.SC-2.* don't want more than one of any color or* any color the same as last timeIF COLORS (J) = KX GO TO SC-1.ADD +1 TO J.IF J NOT > I GO TO SC-2.MOVE KX TO COLORS (I).ADD +1 TO I.GO TO SC-1.SHUFFLE-COLORS-EXIT.EXIT.RANDOM-NUMBER SECTION.* simple LCG algorithm (lifted from Boillot fortran book)MULTIPLY ISEED BY IA GIVING ISEED.IF ISEED < 0 COMPUTE ISEED = -1 * ISEED.ADD IC, ISEED GIVING ISEED.DIVIDE ISEED BY IM GIVING IRNDM REMAINDER ISEED.MOVE ISEED TO FSEED.MOVE IM TO FIM.DIVIDE FSEED BY FIM GIVING FIM.COMPUTE FSEED = 1000.0 * FIM.MOVE FSEED TO IRNDM.RANDOM-NUMBER-EXIT.EXIT.COLOR-LETTERS SECTION.* 1ST 'K' OF KICKS IS COLOR(1)MOVE COLORS (1) TO MAPA06C, MAPA07C, MAPA08C, MAPA09C,MAPA10C, MAPA11C, MAPA12C, MAPA13C,MAPA14C, MAPA15C, MAPA16C, MAPA17C.* 'I' OF KICKS IS COLOR(2)MOVE COLORS (2) TO MAPB06C, MAPB07C, MAPB08C, MAPB09C,MAPB10C, MAPB11C, MAPB12C, MAPB13C,MAPB14C, MAPB15C, MAPB16C, MAPB17C.* 'C' OF KICKS IS COLOR(3)MOVE COLORS (3) TO MAPC06C, MAPC07C, MAPC08C, MAPC09C,MAPC10C, MAPC11C, MAPC12C, MAPC13C,MAPC14C, MAPC15C, MAPC16C, MAPC17C.* 2ND 'K' OF KICKS IS COLOR(4)MOVE COLORS (4) TO MAPD06C, MAPD07C, MAPD08C, MAPD09C,MAPD10C, MAPD11C, MAPD12C, MAPD13C,MAPD14C, MAPD15C, MAPD16C, MAPD17C.* 'S' OF KICKS IS COLOR(5)MOVE COLORS (5) TO MAPE06C, MAPE07C, MAPE08C, MAPE09C,MAPE10C, MAPE11C, MAPE12C, MAPE13C,MAPE14C, MAPE15C, MAPE16C, MAPE17C.COLOR-LETTERS-EXIT.EXIT.
On the first page of that listing you see WS-COMM is defined to hold several variables that need to be passed from one invocation of the transaction to the next: the random number seed and the colors used on the last screen. All these are used to ensure the colors generated this time won’t be boringly similar to the last. In the LINKAGE SECTION you see DFHCOMMAREA as 100 bytes. That's pretty long considering that its target, WS-COMM, is only 9 bytes, but since we use it in a group move it only needs to be longer than WS-COMM, not exactly the same size. It's convenient to define it somewhat longer so future maintainers won't need to worry if it is long enough...
You might also notice a new copybook on that first page of the program listing: DFHBMSCA. This copybook contains mnemonics for BMS color and highlighting attributes: things like DFHRED (red color) and DFHDFT (default color),
Further down the listing you see how the simple test of EIBCALEN has morphed into a 3 way test: Is EIBCALEN zero (if so initialize WS-COMM); Is EIBCALEN = LENGTH OF WS-COMM (if so move DFHCOMMAREA to WS-COMM, RECEIVE MAP, and test for CLEAR); and Is EIBCALEN NOT = LENGTH OF WS-COMM (an error condition for which we initiate our very own ABEND). You also see that just before the SEND MAP we have a PERFORM FILL-IN-MAP.
FILL-IN-MAP is pretty much just standard COBOL, but a few comments are in order. First, moving low‑values to the output map. Recall the output map is just an uninitialized structure in your program’s working storage. If there is junk in there it could mess up your display or even cause an abend. Then there is the moving of various EIB fields to the output map fields with some formatting. FILL-IN-MAP ends with the PERFORMS for SHUFFLE-COLORS and COLOR-LETTERS.
SHUFFLE-COLORS and its associated RANDOM-NUMBER routine is next. Note that the random number routine, while probably OK used to shuffle some colors, is really nothing to write home about. There are much better random number algorithms.
COLOR-LETTERS is the last section of the program. Here the color is applied to the large block letters. The color attribute byte is named by the field name suffixed by a ‘C’. There is also a normal attribute byte, (field name suffixed by ‘A’) which allows manipulation of DIM/BRIGHT/DARK, UNDERLINE, and some other field characteristics. Our program does not use ‘A’ attribute manipulation at all.
You’ve seen how to prepare, compile and use simple KICKS COBOL programs. Not all COBOL programs are so simple! Real world applications involve the correct implementation of sophisticated business rules which invariably leads to complex user interactions and data structures.