The following is the PL/I program as output by the PL/I compiler.
PL/I OPTIMIZING COMPILER /*RETRIEVAL*/ PAGE 2
SOURCE LISTING
STMT LEV NT
/*RETRIEVAL*/
/*DMLIST*/
/*NO_ACTIVITY_LOG*/
/*SCHEMA_COMMENTS*/
1 0 EMPDISP: PROC OPTIONS (MAIN) REORDER;
/*
DCL (EMPSS01 SUBSCHEMA, EMPSCHM SCHEMA VERSION 100)
MODE (IDMS_DC) DEBUG;
*/
2 1 0 DCL IDMSPLI ENTRY OPTIONS(INTER,ASM);
3 1 0 DCL ADDR BUILTIN;
4 1 0 DCL STRING BUILTIN;
/*
DCL (EMPLMAP MAP) TYPE (STANDARD);
*/
5 1 0 DCL TASK_CODE CHAR (8);
6 1 0 DCL EMPDISP CHAR (8) INIT ('EMPDISP');
7 1 0 DCL EMPDISP2 CHAR (8) INIT ('EMPDISP2');
8 1 0 DCL DC_AID_IND_V CHAR (1);
/* LOGICAL CONSTANTS */
9 1 0 DCL YES BIT(1) INIT ('1'B);
10 1 0 DCL NO BIT(1) INIT ('0'B);
11 1 0 DCL 1 PROGRAM_MESSAGES,
3 DISPLAY_MSG CHAR (36)
INIT (' EMPLOYEE INFORMATION DISPLAYED '),
3 NOT_FOUND_MSG CHAR (37)
INIT (' SPECIFIED EMPLOYEE NUMBER NOT FOUND ');
/*
INCLUDE IDMS (SUBSCHEMA_CTRL);
*/
12 1 0 DECLARE 1 SUBSCHEMA_CTRL,
3 PROGRAM CHARACTER (8) INITIAL (' '),
3 ERROR_STATUS CHARACTER (4) INITIAL ('1400'),
3 DBKEY FIXED BINARY (31),
3 RECORD_NAME CHARACTER (16) INITIAL (' '),
3 AREA_NAME CHARACTER (16) INITIAL (' '),
3 ERROR_SET CHARACTER (16) INITIAL (' '),
3 ERROR_RECORD CHARACTER (16) INITIAL (' '),
3 ERROR_AREA CHARACTER (16) INITIAL (' '),
3 IDBMSCOM_AREA,
5 IDBMSCOM (100) CHARACTER (1),
3 DIRECT_DBKEY FIXED BINARY (31),
3 DCBMSCOM_AREA,
5 DCBMSCOM (100) CHARACTER (1),
3 DCCALIGN_AREA,
5 FILLER0001 CHARACTER (4),
5 DCCALIGN FLOAT BINARY (53),
5 FILLER0002 CHARACTER (8);
13 1 0 DECLARE 1 SSC_ERRSAVE_AREA BASED(ADDR(SUBSCHEMA_CTRL.DCCALIGN_AREA)),
3 SSC_ERRSTAT_SAVE CHARACTER (4),
3 SSC_DMLSEQ_SAVE FIXED BINARY (31),
3 DML_SEQUENCE FIXED BINARY (31),
3 RECORD_OCCUR FIXED BINARY (31),
3 SUBSCHEMA_CTRL_END CHARACTER (4);
14 1 0 DECLARE 1 DCCFN_AREA BASED(ADDR(SUBSCHEMA_CTRL.DCBMSCOM_AREA)),
3 FILLER0003 CHARACTER (44),
3 DCCSTR1 CHARACTER (16),
3 DCCNUM1 FIXED BINARY (31),
3 DCCNUM2 FIXED BINARY (31),
3 DCCNUM3 FIXED BINARY (31),
3 DCCFLG1 FIXED BINARY (15),
3 DCCFLG2 FIXED BINARY (15),
3 DCCFLG3 FIXED BINARY (15),
3 DCCFLG4 FIXED BINARY (15),
3 DCCFLG5 FIXED BINARY (15),
3 DCCFLG6 FIXED BINARY (15),
3 FILLER0004 CHARACTER (4),
3 DCCDBLWK CHARACTER (8);
15 1 0 DECLARE 1 DCCPT_AREA BASED(ADDR(SUBSCHEMA_CTRL.DCBMSCOM_AREA)),
3 FILLER0005 CHARACTER (60),
3 DCCPT1 POINTER,
3 DCCPT2 POINTER;
16 1 0 DECLARE 1 DCCPN_AREA BASED(ADDR(SUBSCHEMA_CTRL.DCBMSCOM_AREA)),
3 FILLER0006 CHARACTER (44),
3 DCCPNUM1 FIXED DECIMAL(11,0),
3 FILLER0007 CHARACTER (10),
3 DCCPNUM2 FIXED DECIMAL(7,0);
17 1 0 DECLARE 1 DCCSTR_AREA3 BASED(ADDR(SUBSCHEMA_CTRL.DCBMSCOM_AREA)),
3 FILLER0008 CHARACTER (44),
3 DCCSTR4 CHARACTER (4),
3 DCCSTR5 CHARACTER (4),
3 DCCSTR3 CHARACTER (8);
18 1 0 DECLARE 1 DCCSTR_AREA2 BASED(ADDR(SUBSCHEMA_CTRL.DCBMSCOM_AREA)),
3 FILLER0009 CHARACTER (44),
3 DCCSTR2 CHARACTER (8);
19 1 0 DECLARE 1 DCCSTR_AREA1 BASED(ADDR(SUBSCHEMA_CTRL.DCBMSCOM_AREA)),
3 FILLER0010 CHARACTER (44),
3 DCCSTR6 CHARACTER (32),
3 DCCNUH1 FIXED BINARY (15),
3 FILLER0011 CHARACTER (2),
3 DC_ABEND_CODE CHARACTER (4);
20 1 0 DECLARE 1 DCCPLI_DEFS BASED(ADDR(SUBSCHEMA_CTRL.DCBMSCOM_AREA)),
3 DCCR14SV FIXED BINARY (31),
3 DCCPARMS (10) FIXED BINARY (31);
21 1 0 DECLARE 1 AREA_RNAME BASED(ADDR(SUBSCHEMA_CTRL.AREA_NAME)),
3 SSC_DNO CHARACTER (8),
3 SSC_DNA CHARACTER (8);
22 1 0 DECLARE 1 RRECORD_NAME BASED(ADDR(SUBSCHEMA_CTRL.RECORD_NAME)),
3 SSC_NODN CHARACTER (8),
3 SSC_DBN CHARACTER (8);
/*
INCLUDE IDMS (EMPLOYEE);
*/
23 1 0 DECLARE 1 EMPLOYEE,
2 EMP_ID_0415 PICTURE '(4)9',
2 EMP_NAME_0415,
3 EMP_FIRST_NAME_0415 CHARACTER (10),
3 EMP_LAST_NAME_0415 CHARACTER (15),
2 EMP_ADDRESS_0415,
3 EMP_STREET_0415 CHARACTER (20),
3 EMP_CITY_0415 CHARACTER (15),
3 EMP_STATE_0415 CHARACTER (2),
3 EMP_ZIP_0415,
4 EMP_ZIP_FIRST_FIVE_0415 CHARACTER (5),
4 EMP_ZIP_LAST_FOUR_0415 CHARACTER (4),
2 EMP_PHONE_0415 PICTURE '(10)9',
2 STATUS_0415 CHARACTER (2),
2 SS_NUMBER_0415 PICTURE '(9)9',
2 START_DATE_0415,
3 START_YEAR_0415 PICTURE '(2)9',
3 START_MONTH_0415 PICTURE '(2)9',
3 START_DAY_0415 PICTURE '(2)9',
2 TERMINATION_DATE_0415,
3 TERMINATION_YEAR_0415 PICTURE '(2)9',
3 TERMINATION_MONTH_0415 PICTURE '(2)9',
3 TERMINATION_DAY_0415 PICTURE '(2)9',
2 BIRTH_DATE_0415,
3 BIRTH_YEAR_0415 PICTURE '(2)9',
3 BIRTH_MONTH_0415 PICTURE '(2)9',
3 BIRTH_DAY_0415 PICTURE '(2)9',
2 FILLER0012 CHARACTER (2),
2 FILLER0013 CHARACTER (4);
/*
INCLUDE IDMS (MAP_CONTROLS);
*/
24 1 0 DECLARE 1 MRB_EMPLMAP,
5 MRB_EMPLMAP_ID CHARACTER (8),
5 MRB_EMPLMAP_MCOMP_VER,
8 MRB_EMPLMAP_MCOMP_DATE CHARACTER (8),
8 MRB_EMPLMAP_MCOMP_TIME CHARACTER (6),
8 MRB_EMPLMAP_MCOMP_VERID CHARACTER (2),
5 MRB_EMPLMAP_SUBSCHEMA CHARACTER (8),
5 MRB_EMPLMAP_FLGS (4) CHARACTER (1),
5 FILLER0014 CHARACTER (6),
5 MRB_EMPLMAP_NFLDS FIXED BINARY (15),
5 MRB_EMPLMAP_NRECS FIXED BINARY (15),
5 MRB_EMPLMAP_RECOF FIXED BINARY (15),
5 MRB_EMPLMAP_PERM_CURSOR CHARACTER (2),
5 MRB_EMPLMAP_TEMP_CURSOR CHARACTER (2),
5 MRB_EMPLMAP_PERM_WCC CHARACTER (1),
5 MRB_EMPLMAP_TEMP_WCC CHARACTER (1),
5 MRB_EMPLMAP_CURSOR CHARACTER (2),
5 MRB_EMPLMAP_AID CHARACTER (1),
5 MRB_EMPLMAP_INPUT_FLGS CHARACTER (1),
5 MRB_EMPLMAP_SEGVIEW CHARACTER (1),
5 FILLER0015 CHARACTER (1),
5 MRB_EMPLMAP_MREO FIXED BINARY (15),
5 MRB_EMPLMAP_ERR_CNT FIXED BINARY (15),
5 MRB_EMPLMAP_ATTR_FLGS (4) CHARACTER (1),
5 MRB_EMPLMAP_CURR_MFLD FIXED BINARY (15),
5 MRB_EMPLMAP_XTYP CHARACTER (1),
5 FILLER0016 CHARACTER (1),
5 MRB_EMPLMAP_MRE_XLEN FIXED BINARY (15),
5 MRB_EMPLMAP_MRB_XLEN FIXED BINARY (15),
5 MRB_EMPLMAP_MRE (8),
8 MRB_EMPLMAP_MRE_FLGS (8) CHARACTER (1),
8 MRB_EMPLMAP_MRE_INLEN FIXED BINARY (15),
8 MRB_EMPLMAP_MRE_PAD_CHAR (2) CHARACTER (1),
8 MRB_EMPLMAP_MRE_FLG2 (2) CHARACTER (1),
5 MRB_EMPLMAP_RECS (1) FIXED BINARY (31),
5 MRB_EMPLMAP_END CHARACTER (1),
5 MRB_EMPLMAP_MRE_SUB FIXED BINARY (15);
/* PROCESSING FOLLOWS */
25 1 0 MAIN_LINE: BEGIN;
/* ESTABLISH ADDRESSABILITY FOR */
/*
BIND MAP (EMPLMAP); DMLP0001
*/
26 2 0 /* IDMS PL/I DML EXPANSION */ DO;
27 2 1 DML_SEQUENCE=1;
28 2 1 DCCFLG1,DCCFLG2,DCCNUM1,DCCNUM2=0;
29 2 1 CALL IDMSPLI (SUBSCHEMA_CTRL
,DCBMSCOM (90)
,MRB_EMPLMAP
,MRB_EMPLMAP_END
30 2 1 ); END;
31 2 0 STRING(MRB_EMPLMAP_MCOMP_VER)=
'11/04/87172444R2';
32 2 0 MRB_EMPLMAP_SUBSCHEMA=
'EMPSS01';
33 2 0 MRB_EMPLMAP_ID=
'EMPLMAP';
34 2 0 MRB_EMPLMAP_NFLDS=
8;
35 2 0 MRB_EMPLMAP_NRECS=
1;
36 2 0 MRB_EMPLMAP_RECOF=
112;
37 2 0 MRB_EMPLMAP_MREO=
76;
38 2 0 MRB_EMPLMAP_XTYP=
'0';
39 2 0 MRB_EMPLMAP_MRE_XLEN=
0;
40 2 0 MRB_EMPLMAP_MRB_XLEN=
0;
41 2 0 MRB_EMPLMAP_SEGVIEW=
'N';
42 2 0 CALL IDMS_STATUS;
/*
BIND MAP (EMPLMAP) RECORD (EMPLOYEE); DMLP0002
*/
43 2 0 /* IDMS PL/I DML EXPANSION */ DO;
44 2 1 DML_SEQUENCE=2;
45 2 1 DCCFLG1,DCCFLG2,DCCNUM1,DCCNUM2=0;
46 2 1 CALL IDMSPLI (SUBSCHEMA_CTRL
,DCBMSCOM (91)
,MRB_EMPLMAP_RECS (1)
,EMPLOYEE
47 2 1 ); END;
48 2 0 CALL IDMS_STATUS;
/* DETERMINE THE TASK CODE */
/*
ACCEPT TASK CODE INTO (TASK_CODE); DMLP0003
*/
49 2 0 /* IDMS PL/I DML EXPANSION */ DO;
50 2 1 DML_SEQUENCE=3;
51 2 1 DCCFLG1,DCCFLG2,DCCNUM1,DCCNUM2=0;
52 2 1 DCCNUM1=1;
53 2 1 CALL IDMSPLI (SUBSCHEMA_CTRL
,DCBMSCOM (2)
54 2 1 ); END;
55 2 0 TASK_CODE=DCCSTR6;
56 2 0 CALL IDMS_STATUS;
57 2 0 IF TASK_CODE = EMPDISP
THEN CALL FIRST_TIME;
58 2 0 IF TASK_CODE = EMPDISP2
THEN CALL SECOND_TIME;
/* OTHERWISE RETURN TO IDMS DC */
/*
DC RETURN; DMLP0004
*/
59 2 0 /* IDMS PL/I DML EXPANSION */ DO;
60 2 1 DML_SEQUENCE=4;
61 2 1 DCCFLG1,DCCFLG2,DCCNUM1,DCCNUM2=0;
62 2 1 CALL IDMSPLI (SUBSCHEMA_CTRL
,DCBMSCOM (19)
63 2 1 ); END;
64 2 0 FIRST_TIME: PROC;
/*
MODIFY MAP (EMPLMAP) DMLP0005
FOR ALL BUT DFLD (EMP_ID_0415)
ATTRIBUTES PROTECTED;
*/
65 3 0 /* IDMS PL/I DML EXPANSION */ DO;
66 3 1 DML_SEQUENCE=5;
67 3 1 DCCFLG1,DCCFLG2,DCCNUM1,DCCNUM2=0;
68 3 1 DCCNUM1=8;
69 3 1 DCCFLG1=768;
70 3 1 DCCFLG3=0;
71 3 1 DCCFLG4=0;
72 3 1 CALL IDMSPLI (SUBSCHEMA_CTRL
,DCBMSCOM (93)
,MRB_EMPLMAP
,MRB_EMPLMAP_MRE (1)
73 3 1 ); END;
/*
MAP OUT(EMPLMAP) DMLP0006
IO OUTPUT DATA YES NEWPAGE;
*/
74 3 0 /* IDMS PL/I DML EXPANSION */ DO;
75 3 1 DML_SEQUENCE=6;
76 3 1 DCCFLG1,DCCFLG2,DCCNUM1,DCCNUM2=0;
77 3 1 DCCFLG1=5;
78 3 1 DCCFLG2=16;
79 3 1 DCCFLG3=1;
80 3 1 DCCFLG4=0;
81 3 1 DCCFLG5=0;
82 3 1 DCCFLG6=1;
83 3 1 CALL IDMSPLI (SUBSCHEMA_CTRL
,DCBMSCOM (34)
,MRB_EMPLMAP
84 3 1 ); END;
85 3 0 CALL IDMS_STATUS;
/*
DC RETURN NEXT TASK CODE(EMPDISP2); DMLP0007
*/
86 3 0 /* IDMS PL/I DML EXPANSION */ DO;
87 3 1 DML_SEQUENCE=7;
88 3 1 DCCFLG1,DCCFLG2,DCCNUM1,DCCNUM2=0;
89 3 1 DCCSTR2=EMPDISP2;
90 3 1 DCCFLG1=128;
91 3 1 CALL IDMSPLI (SUBSCHEMA_CTRL
,DCBMSCOM (19)
92 3 1 ); END;
93 3 0 END FIRST_TIME;
94 2 0 SECOND_TIME: PROC;
/*
MAP IN (EMPLMAP) DMLP0008
IO INPUT DATA YES;
*/
95 3 0 /* IDMS PL/I DML EXPANSION */ DO;
96 3 1 DML_SEQUENCE=8;
97 3 1 DCCFLG1,DCCFLG2,DCCNUM1,DCCNUM2=0;
98 3 1 DCCFLG1=6;
99 3 1 DCCFLG2=4;
100 3 1 DCCFLG3=0;
101 3 1 DCCFLG4=0;
102 3 1 DCCFLG5=0;
103 3 1 DCCFLG6=0;
104 3 1 CALL IDMSPLI (SUBSCHEMA_CTRL
,DCBMSCOM (34)
,MRB_EMPLMAP
105 3 1 ); END;
106 3 0 CALL IDMS_STATUS;
/* CHECK WHICH PF KEY WAS PRESSED */
/*
INQUIRE MAP(EMPLMAP) DMLP0009
MOVE AID TO (DC_AID_IND_V);
*/
107 3 0 /* IDMS PL/I DML EXPANSION */ DO;
108 3 1 DML_SEQUENCE=9;
109 3 1 DCCFLG1,DCCFLG2,DCCNUM1,DCCNUM2=0;
110 3 1 DCCNUM1=7;
111 3 1 CALL IDMSPLI (SUBSCHEMA_CTRL
,DCBMSCOM (92)
,MRB_EMPLMAP
112 3 1 ); END;
113 3 0 DC_AID_IND_V=DCCSTR2;
/* STOP IF PA1 (%) WAS PRESSED */
114 3 0 IF DC_AID_IND_V = '%'
THEN DMLP0010
/*
DC RETURN;
*/
/* IDMS PL/I DML EXPANSION */ DO;
115 3 1 DML_SEQUENCE=10;
116 3 1 DCCFLG1,DCCFLG2,DCCNUM1,DCCNUM2=0;
117 3 1 CALL IDMSPLI (SUBSCHEMA_CTRL
,DCBMSCOM (19)
118 3 1 ); END;
/*
BIND RUN_UNIT; DMLP0011
*/
119 3 0 /* IDMS PL/I DML EXPANSION */ DO;
120 3 1 DML_SEQUENCE=11;
121 3 1 DCCFLG1,DCCFLG2,DCCNUM1,DCCNUM2=0;
122 3 1 CALL IDMSPLI (SUBSCHEMA_CTRL
,IDBMSCOM (59)
,SUBSCHEMA_CTRL
,'EMPSS01 '
123 3 1 ); END;
124 3 0 CALL IDMS_STATUS;
/*
BIND RECORD (EMPLOYEE); DMLP0012
*/
125 3 0 /* IDMS PL/I DML EXPANSION */ DO;
126 3 1 DML_SEQUENCE=12;
127 3 1 DCCFLG1,DCCFLG2,DCCNUM1,DCCNUM2=0;
128 3 1 CALL IDMSPLI (SUBSCHEMA_CTRL
,IDBMSCOM (48)
,'EMPLOYEE '
,EMPLOYEE
129 3 1 ); END;
130 3 0 CALL IDMS_STATUS;
/*
READY AREA (EMP_DEMO_REGION); DMLP0013
*/
131 3 0 /* IDMS PL/I DML EXPANSION */ DO;
132 3 1 DML_SEQUENCE=13;
133 3 1 DCCFLG1,DCCFLG2,DCCNUM1,DCCNUM2=0;
134 3 1 CALL IDMSPLI (SUBSCHEMA_CTRL
,IDBMSCOM (37)
,'EMP-DEMO-REGION '
135 3 1 ); END;
136 3 0 CALL IDMS_STATUS;
/* OBTAIN THE RECORD */
/*
OBTAIN CALC RECORD (EMPLOYEE); DMLP0014
*/
137 3 0 /* IDMS PL/I DML EXPANSION */ DO;
138 3 1 DML_SEQUENCE=14;
139 3 1 DCCFLG1,DCCFLG2,DCCNUM1,DCCNUM2=0;
140 3 1 CALL IDMSPLI (SUBSCHEMA_CTRL
,IDBMSCOM (32)
,'EMPLOYEE '
,IDBMSCOM (43)
141 3 1 ); END;
142 3 0 IF ERROR_STATUS = '0326' THEN CALL NO_EMP;
143 3 0 CALL IDMS_STATUS;
/*
FINISH; DMLP0015
*/
144 3 0 /* IDMS PL/I DML EXPANSION */ DO;
145 3 1 DML_SEQUENCE=15;
146 3 1 DCCFLG1,DCCFLG2,DCCNUM1,DCCNUM2=0;
147 3 1 CALL IDMSPLI (SUBSCHEMA_CTRL
,IDBMSCOM (2)
148 3 1 ); END;
149 3 0 CALL IDMS_STATUS;
/* TRANSMIT THE DATA BACK TO THE SCREEN */
/*
MAP OUT(EMPLMAP) DMLP0016
IO OUTPUT DATA YES NEWPAGE
MESSAGE(DISPLAY_MSG) LENGTH(36);
*/
150 3 0 /* IDMS PL/I DML EXPANSION */ DO;
151 3 1 DML_SEQUENCE=16;
152 3 1 DCCFLG1,DCCFLG2,DCCNUM1,DCCNUM2=0;
153 3 1 DCCFLG1=5;
154 3 1 DCCFLG2=16;
155 3 1 DCCFLG3=1;
156 3 1 DCCFLG4=4;
157 3 1 DCCFLG5=0;
158 3 1 DCCFLG6=1;
159 3 1 CALL IDMSPLI (SUBSCHEMA_CTRL
,DCBMSCOM (34)
,MRB_EMPLMAP
,DISPLAY_MSG
,DCBMSCOM (36)
160 3 1 ); END;
161 3 0 CALL IDMS_STATUS;
/*
DC RETURN NEXT TASK CODE(EMPDISP2); DMLP0017
*/
162 3 0 /* IDMS PL/I DML EXPANSION */ DO;
163 3 1 DML_SEQUENCE=17;
164 3 1 DCCFLG1,DCCFLG2,DCCNUM1,DCCNUM2=0;
165 3 1 DCCSTR2=EMPDISP2;
166 3 1 DCCFLG1=128;
167 3 1 CALL IDMSPLI (SUBSCHEMA_CTRL
,DCBMSCOM (19)
168 3 1 ); END;
169 3 0 END SECOND_TIME;
170 2 0 NO_EMP: PROC;
/* DO THIS IF EMPLOYEE NOT FOUND */
/*
MAP OUT(EMPLMAP) DMLP0018
IO OUTPUT DATA YES NEWPAGE
MESSAGE(NOT_FOUND_MSG) LENGTH(37);
*/
171 3 0 /* IDMS PL/I DML EXPANSION */ DO;
172 3 1 DML_SEQUENCE=18;
173 3 1 DCCFLG1,DCCFLG2,DCCNUM1,DCCNUM2=0;
174 3 1 DCCFLG1=5;
175 3 1 DCCFLG2=16;
176 3 1 DCCFLG3=1;
177 3 1 DCCFLG4=4;
178 3 1 DCCFLG5=0;
179 3 1 DCCFLG6=1;
180 3 1 CALL IDMSPLI (SUBSCHEMA_CTRL
,DCBMSCOM (34)
,MRB_EMPLMAP
,NOT_FOUND_MSG
,DCBMSCOM (37)
181 3 1 ); END;
182 3 0 CALL IDMS_STATUS;
/*
DC RETURN NEXT TASK CODE(EMPDISP2); DMLP0019
*/
183 3 0 /* IDMS PL/I DML EXPANSION */ DO;
184 3 1 DML_SEQUENCE=19;
185 3 1 DCCFLG1,DCCFLG2,DCCNUM1,DCCNUM2=0;
186 3 1 DCCSTR2=EMPDISP2;
187 3 1 DCCFLG1=128;
188 3 1 CALL IDMSPLI (SUBSCHEMA_CTRL
,DCBMSCOM (19)
189 3 1 ); END;
190 3 0 END NO_EMP;
/*
INCLUDE IDMS (IDMS_STATUS);
*/
191 2 0 IDMS_STATUS: PROC;
/* THE IDMS_STATUS PROCEDURE MAY BE CALLED BY THE USER AFTER */
/* EACH IDMS COMMAND HAS BEEN ISSUED AND CHECKS HAVE BEEN */
/* MADE FOR ANY EXPECTED NON_ZERO ERROR STATUS CONDITIONS. */
/* IT DETECTS A NON_ZERO ERROR_STATUS AND TERMINATES THE */
/* PROGRAM WITH A SNAP OF THE SUBSCHEMA_CTRL AREA AND AN */
/* ABEND WITH THE ERROR_STATUS AS THE ABEND CODE. */
192 3 0 IF ERROR_STATUS='0000' THEN GOTO END_STATUS;
193 3 0 SSC_ERRSTAT_SAVE=ERROR_STATUS; /* SAVE THE ERROR_STATUS */
194 3 0 SSC_DMLSEQ_SAVE=DML_SEQUENCE; /* SAVE DML_SEQUENCE */
/* SNAP THE SUBSCHEMA_CTRL AREA */
/*
SNAP FROM (SUBSCHEMA_CTRL) TO (SUBSCHEMA_CTRL_END);
*/
195 3 0 /* IDMS PL/I DML EXPANSION */ DO;
196 3 1 DML_SEQUENCE=20;
197 3 1 DCCFLG1,DCCFLG2,DCCNUM1,DCCNUM2=0;
198 3 1 CALL IDMSPLI (SUBSCHEMA_CTRL
,DCBMSCOM (22)
,DCCSTR1
,DCCSTR1
,DCCSTR1
,SUBSCHEMA_CTRL
,SUBSCHEMA_CTRL_END
,DCBMSCOM (1)
199 3 1 ); END;
/* ABEND */
/*
ABEND CODE (SSC_ERRSTAT_SAVE);
*/
200 3 0 /* IDMS PL/I DML EXPANSION */ DO;
201 3 1 DML_SEQUENCE=21;
202 3 1 DCCFLG1,DCCFLG2,DCCNUM1,DCCNUM2=0;
203 3 1 DCCSTR4=SSC_ERRSTAT_SAVE;
204 3 1 DCCFLG1=2;
205 3 1 CALL IDMSPLI (SUBSCHEMA_CTRL
,DCBMSCOM (1)
206 3 1 ); END;
207 3 0 END_STATUS: END;
208 2 0 END MAIN_LINE; /* END MAIN_LINE */
209 1 0 END EMPDISP;
|
Copyright © 2014 CA.
All rights reserved.
|
|