PL/X

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
@PROCESS XOPTS(PLS,PLSA0,SP,EDF,NODEBUG)
OPTIMIZE(ADV)
TITLE('CIUCINS - CINS transaction Dependency Statistics program');
EXAMPPLI:PROC(EIBLK)
OPTIONS (MAIN,REENTRANT,
PATCH,
COPYRIGHT('5655-Y22',CORP,'2014'),
STACK('DFHEIPLS','DFHEIPLR'),
SAVEAREA(96),
AMODE(31),
RMODE(ANY),
/*CODEREG(*),*/
STATNUM(1),
DATANUM(1));
DCL EIBLK CHAR(*);
DCL DFHEIPTR PTR(31);
DCL I BIN(32),
J BIN(32),
INPUT CHAR(80),
COUNT BIN(32),
NAMETRAN CHAR(80),
NAMEQUEUE CHAR(8),
NUMRECORDS BIN(32),
STR CHAR(80);
DFHEIPTR=ADDR(EIBLK);
GEN CODE (SYSSTATE ARCHLVL=1);
INPUT = '';
COUNT = 0;
NAMETRAN = '';
NAMEQUEUE = '';
NUMRECORDS = 0;
STR = '';
J = 1;
EXEC CICS RECEIVE INTO(INPUT) LENGTH(LENGTH(INPUT));
DO I = 1 TO LENGTH(INPUT);
IF (INPUT(I) = ' ') THEN
DO;
COUNT = COUNT + 1;
J = 1;
END;
ELSE
SELECT(COUNT);
WHEN(0)
DO;
NAMETRAN(J) = INPUT(I);
J = J + 1;
END;
WHEN(1)
DO;
NAMEQUEUE(J) = INPUT(I);
J = J + 1;
END;
WHEN(2)
DO;
NUMRECORDS = CHAR4_TO_BIN32(INPUT(I));
J = J + 1;
END;
WHEN(3)
DO;
STR(J) = INPUT(I);
J = J + 1;
END;
OTHERWISE;
END;
END;
DO I = 1 TO NUMRECORDS;
EXEC CICS WRITEQ TS QUEUE(NAMEQUEUE) FROM(STR);
END;
EXEC CICS RETURN;
/********************************************************************/
/* CHAR4_TO_BIN32 */
/********************************************************************/
/* Converts character symbol string of 4 symbols CHAR(4)into the */
/* BIN(32) format */
/********************************************************************/
CHAR4_TO_BIN32:PROC(CHAR4) RETURNS(BIN(32));
DCL CHAR8 CHAR(8);
DCL CHAR4 CHAR(4);
DCL CHAR11 CHAR(4);
DCL B32 BIN(32);
DCL I BIN(32);
DCL COMMENT_VA CHAR(30);
CHAR11='';
I=1;
DO WHILE( (CHAR4(I)<>'40'X) & (I<5));
I=I+1;
END;
I=I-1;
IF I=0 THEN B32=0;
ELSE
DO;
CHAR11(5-I::I)=CHAR4(1::I);
PACK(CHAR8,CHAR11);
CVB(B32,CHAR8);
END;
RETURN(B32);
END CHAR4_TO_BIN32;
END EXAMPPLI;