CICS Application Programming Fundamentals 第4章
4. The Execute Interface
TRANS(SHWE), PROG(EIBSHOW), MAP(EIBMAPS)
註: 105-112 行跟原視頻的不同，這裡修改了一下，也包括按 Esc, PA1, PA2 的 MAPFAIL 處理
****** ********************************* Top of Data **********************************
000001 Identification Division.
000002 Program-Id. EIBSHOW.
000003 Data Division.
000004 Working-Storage Section.
000005 copy EIBMAPS.
000006 copy DFHBMSCA.
000007 copy DFHAID.
000008 01 filler.
000009 05 ws-response-code pic s9(09) binary.
000010 05 ws-eibdate pic 9(07).
000011 05 filler redefines ws-eibdate.
000012 10 filler pic x.
000013 10 ws-century pic 9.
000014 10 ws-year-last-2 pic 9(02).
000015 10 ws-3-digit-day pic 9(03).
000016 05 filler.
000017 10 ws-base-year pic 9(04) value 1900.
000018 10 ws-century-factor pic 9(03) value 100.
000019 10 ws-leap-adjust pic 9.
000020 05 ws-formatted-date.
000021 10 ws-form-month pic x(04).
000022 10 ws-form-day pic z9.
000023 10 filler pic x(02) value ', '.
000024 10 ws-form-year pic 9(04).
000025 05 ws-month-values.
000026 10 filler pic x(03) value 'Jan'.
000027 10 filler pic s9(03) packed-decimal value 31.
000028 10 filler pic x(03) value 'Feb'.
000029 10 filler pic s9(03) packed-decimal value 59.
000030 10 filler pic x(03) value 'Mar'.
000031 10 filler pic s9(03) packed-decimal value 90.
000032 10 filler pic x(03) value 'Apr'.
000033 10 filler pic s9(03) packed-decimal value 120.
000034 10 filler pic x(03) value 'May'.
000035 10 filler pic s9(03) packed-decimal value 151.
000036 10 filler pic x(03) value 'Jun'.
000037 10 filler pic s9(03) packed-decimal value 182.
000038 10 filler pic x(03) value 'Jul'.
000039 10 filler pic s9(03) packed-decimal value 212.
000040 10 filler pic x(03) value 'Aug'.
000041 10 filler pic s9(03) packed-decimal value 243.
000042 10 filler pic x(03) value 'Sep'.
000043 10 filler pic s9(03) packed-decimal value 274.
000044 10 filler pic x(03) value 'Oct'.
000045 10 filler pic s9(03) packed-decimal value 304.
000046 10 filler pic x(03) value 'Nov'.
000047 10 filler pic s9(03) packed-decimal value 335.
000048 10 filler pic x(03) value 'Dec'.
000049 10 filler pic s9(03) packed-decimal value 365.
000050 05 ws-month-table redefines ws-month-values.
000051 10 ws-month-entry occurs 12 times
000052 indexed by month-ix.
000053 15 ws-month-abbrev pic x(03).
000054 15 ws-end-day pic s9(03) packed-decimal.
000055 05 ws-eibtime pic 9(07).
000056 05 ws-time-breakout redefines ws-eibtime.
000057 10 filler-t-b pic x.
000058 10 ws-hour pic 9(02).
000059 10 ws-minute pic x(02).
000060 10 ws-second pic x(02).
000061 05 ws-formatted-time.
000062 10 ws-hour pic z9.
000063 10 filler-f-t-1 pic x value ':'.
000064 10 ws-minute pic x(02).
000065 10 filler-f-t-2 pic x value ':'.
000066 10 ws-second pic x(02).
000067 05 ws-loop-control pic s9(03) packed-decimal.
000068 Procedure Division.
000069 perform 0000-Loop
000070 varying ws-loop-control from 1 by 1
000071 until ws-loop-control greater than 10
000072 EXEC CICS SEND CONTROL FREEKB ERASE END-EXEC
000073 EXEC CICS RETURN END-EXEC
000074 .
000075 0000-Loop.
000076 initialize EIBMAPMO
000077 perform 1000-Format-the-Date
000078 move ws-formatted-date to EDATEO
000079 perform 2000-Format-the-Time
000080 move ws-formatted-time to ETIMEO
000081 move EIBTRNID to ETRANO
000082 move EIBTASKN to ETASKO
000083 move EIBTRMID to ETERMO
000084 move EIBTRNID to NEXTO
000085 move DFHBMFSE to NEXTA
000086 EXEC CICS SEND
000087 MAP('EIBMAPM')
000088 MAPSET('EIBMAPS')
000089 FROM(EIBMAPMO)
000090 FREEKB
000091 ERASE
000092 END-EXEC
000093 EXEC CICS RECEIVE
000094 MAP('EIBMAPM')
000095 MAPSET('EIBMAPS')
000096 INTO(EIBMAPMI)
000097 RESP(ws-response-code)
000098 END-EXEC
000099 * if EIBRESP equal DFHRESP(MAPFAIL)
000100 * continue
000101 * end-if
000102 * if EIBAID equal DFHPF3
000103 * move 100 to ws-loop-control
000104 * end-if
000105 evaluate true
000106 when ws-response-code = DFHRESP(MAPFAIL)
000107 continue
000108 when other
000109 if EIBAID = DFHPF3
000110 move 100 to ws-loop-control
000111 end-if
000112 end-evaluate
000113 .
000114 1000-Format-the-Date.
000115 move EIBDATE to ws-eibdate
000116 compute ws-form-year = ws-year-last-2 +
000117 (ws-base-year +
000118 (ws-century * ws-century-factor))
000119 end-compute
000120 if ws-3-digit-day less than 28
000121 move 0 to ws-leap-adjust
000122 else
000123 compute ws-leap-adjust =
000124 function mod(ws-form-year, 4)
000125 end-compute
000126 if function mod(ws-form-year, 100) equal zero
000127 and function mod(ws-form-year, 400) not equal zero
000128 move 0 to ws-leap-adjust
000129 end-if
000130 end-if
000131 set month-ix to 1
000132 search ws-month-entry
000133 varying month-ix
000134 when ws-3-digit-day
000135 less than or equal to ws-end-day(month-ix) + 1
000136 move ws-month-abbrev(month-ix) to ws-form-month
000137 if ws-3-digit-day less than 31
000138 compute ws-form-day = ws-3-digit-day
000139 else
000140 compute ws-form-day =
000141 ws-end-day(month-ix - 1) - ws-3-digit-day
000142 end-compute
000143 end-if
000144 end-search 000141 .
000142 2000-Format-the-Time.
000143 move EIBTIME to ws-eibtime
000144 move corresponding ws-time-breakout to ws-formatted-time
000145 .
****** ******************************** Bottom of Data ********************************
****** ********************************* Top of Data **********************************
000001 EIBMAPS DFHMSD TYPE=&SYSPARM, X
000002 CTRL=(FREEKB,FRSET), X
000003 LANG=COBOL, X
000004 MAPATTS=(COLOR,HILIGHT), X
000005 MODE=INOUT, X
000006 STORAGE=AUTO, X
000007 TIOAPFX=YES
000008 EIBMAPM DFHMDI SIZE=(24,80),LINE=1,COLUMN=1
000009 NEXT DFHMDF POS=(1,1),LENGTH=16,INITIAL='SHWE', X
000010 ATTRB=(UNPROT,IC)
000011 DFHMDF POS=(1,29),LENGTH=21, X
000012 INITIAL='Selected EIBLK fields'
000013 DFHMDF POS=(3,9),LENGTH=16, X
000014 INITIAL=' Date:'
000015 EDATE DFHMDF POS=(3,30),LENGTH=12,ATTRB=(PROT)
000016 DFHMDF POS=(4,9),LENGTH=16, X
000017 INITIAL=' Time (UTC):'
000018 ETIME DFHMDF POS=(4,30),LENGTH=8,ATTRB=(PROT)
000019 DFHMDF POS=(5,9),LENGTH=16, X
000020 INITIAL=' Transaction id:'
000021 ETRAN DFHMDF POS=(5,30),LENGTH=4,ATTRB=(PROT)
000022 DFHMDF POS=(6,9),LENGTH=16, X
000023 INITIAL=' Task number:'
000024 ETASK DFHMDF POS=(6,30),PICOUT='9999999',ATTRB=(PROT)
000025 DFHMDF POS=(7,9),LENGTH=16, X
000026 INITIAL=' Terminal id:'
000027 ETERM DFHMDF POS=(7,30),LENGTH=4,ATTRB=(PROT)
000028 DFHMDF POS=(24,1),LENGTH=17,INITIAL='Press F3 to exit'
000029 DFHMSD TYPE=FINAL
000030 END
****** ******************************** Bottom of Data ********************************