zOs/war/plb0
}¢--- A540769.WK.PLB(MF7800) cre=2014-11-27 mod=2014-11-27-16.56.59 A540769 ----
/********************************************************************/
/* */
/* Letzte Source-Änderung: 21. May. 2012 09:12 F542850 */
/* */
/********************************************************************/
/* ----------------------------------------------------------------- * 00010002
¦ vvv ¦ 00020002
¦ Package.....: MFR_sfl_history ~~~~~ ¦ 00030002
¦ ( O O ) ¦ 00040002
+ -----------------------------------------------oooo--(_)--oooo--- + 00050002
¦ ¦ 00060002
¦ Autor.......: Corrado Garbagnati KGCG 21 ¦ 00070002
¦ Datum.......: 10/09/2010 ¦ 00080002
¦ .oooO ¦ 00090002
+ -------------------------------------------------( )-Oooo.----- + 00100002
¦ \ ( ( ) ¦ 00110002
¦ \_) ) / ¦ 00120002
¦ (_/ ¦ 00130002
+ ----------------------------------------------------------------- + 00140002
¦ ¦ 00160002
¦ Exports.....: MF7800 ¦ 00160002
¦ ¦ 00160002
+ ----------------------------------------------------------------- + 00140002
¦ Beschreibung: ¦ 00150002
¦ ¦ 00160002
¦ Das Programm historisiert Flüsse, welcher älter als ein Jahr ¦ 00160002
¦ sind. Dieser Prozess koptiert die Daten in TMF150H1 und löscht ¦ 00160002
¦ sie in TMF150A1. ¦ 00160002
¦ Um regelmässiges Absetzen von Commits zu ermöglichen, werden ¦ 00160002
¦ die Daten in Blöcken kopiert. Die Blockgrösse ist in ¦ 00160002
¦ Makro @blocksize (1000) definiert. Dieser Wert kann ¦ 00160002
¦ von "aussen" nicht verändert werden. ¦ 00160002
¦ ¦ 00160002
¦ Das Programm läuft wöchentich jeweils am Sonntag. ¦ 00160002
¦ ¦ 00160002
¦ Es stehen mehrere Transfer-Algorithmen zur Verfügung, die ¦ 00160002
¦ unterschiedliche Strategien verfolgen: ¦ 00160002
¦ ¦ 00160002
¦ Version 0 und 1: ¦ 00160002
¦ ¦ 00160002
¦ - Ermitteln der zu transferrierenden Flüsse und speichern ¦ 00160002
¦ deren Schlüssel in temporärer DB2-Tabelle ¦ 00160002
¦ ¦ 00160002
¦ - Kopieren dieser Flüsse in TMF150H1 anhand dieser Schlüssel ¦ 00160002
¦ ¦ 00160002
¦ - Löschen dieser Flüsse in TMF150A1 ¦ 00160002
¦ ¦ 00160002
¦ Vorteil: Daten verbeiben innerhalb von DB2 ¦ 00160002
¦ Nachteil: Daten können nicht mit Garantie in Clustering- ¦ 00160002
¦ Reihenfolge in TMF150H1 eingefügt werden ¦ 00160002
¦ (Fragmentierung). ¦ 00160002
¦ Datensuche erfolgt sowohl beim Kopieren als auch ¦ 00160002
¦ beim Löschen. ¦ 00160002
¦ ¦ 00160002
¦ Version 2: ¦ 00160002
¦ ¦ 00160002
¦ - Lesen der gelöschten Daten (SELECT FROM DELETE) mittels ¦ 00160002
¦ Cusrorverarbeitung. ¦ 00160002
¦ ¦ 00160002
¦ - Einfügen der Flüsse in TMF150H1 (FETCH and INSERT). ¦ 00160002
¦ ¦ 00160002
¦ Vorteil: Einfügen der Daten in TMF150H1 in Clustering- ¦ 00160002
¦ Reihenfolge. ¦ 00160002
¦ Nachteil: Daten verbleiben nicht innerhalb von DB2 (kopieren ¦ 00160002
¦ in den Adressraum des Programmes). ¦ 00160002
¦ ¦ 00160002
¦ Version 3 (Walters Vorschlag): ¦ 00160002
¦ ¦ 00160002
¦ - Ermitteln der zu transferrierenden Flüsse und speichern ¦ 00160002
¦ deren Schlüssel in temporärer DB2-Tabelle ¦ 00160002
¦ ¦ 00160002
¦ - Kopieren dieser Flüsse in TMF150H1 anhand dieser Schlüssel ¦ 00160002
¦ ¦ 00160002
¦ - Löschen dieser Flüsse in TMF150A1 ¦ 00160002
¦ ¦ 00160002
¦ Vorteil: Daten verbeiben innerhalb von DB2 ¦ 00160002
¦ Nachteil: Daten können nicht mit Garantie in Clustering- ¦ 00160002
¦ Reihenfolge in TMF150H1 eingefügt werden ¦ 00160002
¦ (Fragmentierung). ¦ 00160002
¦ Datensuche erfolgt sowohl beim Kopieren als auch ¦ 00160002
¦ beim Löschen. ¦ 00160002
¦ Anzahl der ermittelten Flüsse ist variable. ¦ 00160002
¦ ¦ 00160002
¦ Version 4: ¦ 00160002
¦ ¦ 00160002
¦ - Lesen der eingefügten Daten (SELECT FROM INSERT) mittels ¦ 00160002
¦ Cusrorverarbeitung (ROWSET FETCH). ¦ 00160002
¦ ¦ 00160002
¦ - Kopieren der UUID in temp. Tabelle (ROWSET INSERT) ¦ 00160002
¦ Cusrorverarbeitung (ROWSET FETCH). ¦ 00160002
¦ ¦ 00160002
¦ - Löschen in TMF150A1 anhand der temp. Tabelle. ¦ 00160002
¦ ¦ 00160002
¦ Nachteil: Daten verbleiben nicht innerhalb von DB2 (kopieren ¦ 00160002
¦ in den Adressraum des Programmes). ¦ 00160002
¦ Daten werden auch in temp. Tabelle kopiert ¦ 00160002
¦ (FINAL TABLE). ¦ 00160002
¦ ¦ 00160002
¦ Durch Performancetests soll der effektivere Algorithmus ¦ 00160002
¦ evaluiert werden. ¦ 00160002
¦ ¦ 00160002
¦ Berechnung des "älter als" Datums: ¦ 00160002
¦ ¦ 00160002
¦ - Aktuelles Datum - 365 Tage ¦ 00160002
¦ ¦ 00160002
¦ - Falls dieses Datum nicht auf einen Sonntag fällt, muss ¦ 00160002
¦ der vorangegangene Sonntag ermittelt werden. ¦ 00160002
¦ ¦ 00160002
¦ Programmparameter (aus Konfigurationsdatei): ¦ 00160002
¦ ¦ 00160002
¦ <?xml version="1.0" encoding="ebcdic-cp-ch" standalone="yes"?> ¦ 00160002
¦ <|--configuration of programm MF7800--> ¦ 00160002
¦ <configuration> ¦ 00160002
¦ <parameter-list> ¦ 00160002
¦ <parameter name="use-version"> 2</parameter>¦ 00160002
¦ <parameter name="print-after-#sfl"> 5000</parameter>¦ 00160002
¦ <parameter name="stop-after-#sfl"> 50000</parameter>¦ 00160002
¦ <parameter name="older-than-date"> 01.09.2009</parameter>¦ 00160002
¦ </parameter-list> ¦ 00160002
¦ </configuration> ¦ 00160002
¦ ¦ 00160002
¦ ¦ 00160002
¦ use-version: Verwende Version 2 (Default: Version 1) ¦ 00160002
¦ ¦ 00160002
¦ print-after-#sfl: Schreibe Meldung nach 5000 Flüssen ¦ 00160002
¦ (Default: 50000) ¦ 00160002
¦ ¦ 00160002
¦ stop-after-#sfl: Stoppe Verarbeitung nach 50000 Flüssen ¦ 00160002
¦ (Default: -1 - kein Stopp) ¦ 00160002
¦ ¦ 00160002
¦ older-than-date: Verwende dises "älter als" Datum ¦ 00160002
¦ (Default: berechnetes Dat.) ¦ 00160002
¦ ¦ 00160002
+ ----------------------------------------------------------------- + 00170002
¦ Bemerkung...: ¦ 00180002
¦ ¦ 00160002
¦ Die ersten Unittests wurden im DBAF mit dem Schema GDB0389 ¦ 00160002
¦ gemacht (siehe Makro @schema). Für den üblichen ET sollte ¦ 00160002
¦ kein Schema angegeben werden (Blank). Wird durch den Promote ¦ 00160002
¦ eingefügt. ¦ 00160002
¦ ¦ 00160002
+ ----------------------------------------------------------------- + 00170002
¦ Aenderungen.: ¦ 00180002
¦ ¦ 00190002
¦ 18.05.2012 Requirements: MFR-FoF_nfr_CS_Standard Ph.Franzos ¦ 00190002
¦ CR : 7079 PF0512 ¦ 00190002
¦ EPLI V4.2: SQL-Statements dürfen nur noch ¦ 00190002
¦ innerhalb einer Procedur deklariert werden. ¦ 00190002
¦ ¦ 00190002
¦ 10.09.2010 Intial ¦
¦ ¦
¦ CR 7021 (NEUVA) ¦
¦ Requirement MFR-FoF_nfr_Table_0001 ¦
¦ MFR-FoF_nfr_Table_0002 ¦
¦ Deployment: DC 4-2010 ¦
¦ ¦
* ----------------------------------------------------------------- */00200002
1/* ----------------------------------------------------------------- * 00930002
¦ Package ¦ 00940002
* ----------------------------------------------------------------- */00950002
MFR_sfl_history: package exports (MF7800);
%;
%/* Macros */;
%;
%/* Condition codes */;
%dcl @cc_ok char; %@cc_ok = '0';
%dcl @cc_err char; %@cc_err = '999';
%;
%/* SQL-States */;
%xinclude YMFWS00H;
%dcl @sqlDuplicate char; %@sqlDuplicate = '''23505''';
%;
%/* DB2-Schema GDB0389 (wird für Unittests verwendet: sonst Blank) */;
%dcl @schema char; %@schema = '';
%;
%/* setze Schema vor Tabellennamen */;
%@table: proc ($schema, $tableName) returns (char);
dcl $schema char;
dcl $tableName char;
/* Aufruf ohne Schema */
if length (trim ($schema)) < 1 then return (trim ($tableName));
return (trim ($schema) || '.' || trim ($tableName));
%end @table;
%activate @table;
%;
%/* Anzahl Historisierungen in einer Unit of Work */;
%dcl @blocksize char; %@blocksize = '500';
%dcl @blocksize_3 char; %@blocksize_3 = '10';
%;
%/* Format Buchungsdatum */;
%dcl @dateFmt char; %@dateFmt = '''DD.MM.YYYY''';
%;
%/* Default Datum */;
%dcl @dfltDate char; %@dfltDate = '''01.01.0001''';
%;
%/* sonstiges */;
%xinclude MFRMACH;
%;
1/* -Built-In's------------------------------------------------------ */01430002
dcl ( 01440002
addr 01590002
,datetime 01590002
,days 01590002
,daystodate 01590002
,edit 01590002
,float 01590002
,handle
,hbound
,hex
,huge
,lbound 01590002
,length 01590002
,lowercase
,mod 01590002
,omitted 01590002
,oncode 01590002
,onloc 01590002
,packagename 01590002
,plidelete 01590002
,plidump 01590002
,plifill
,present
,procedurename
,ptrvalue
,round
,sqrt
,sysnull
,uppercase
,validdate
,weekday
) builtin; 01600002
01010002
/* -External(s)----------------------------------------------------- */01430002
/* -Define(s)------------------------------------------------------- */01430002
define structure
1 rtSta_t /* Runtime Statistik */
,2 sumX float dec (16) /* Summe */
,2 sumX2 float dec (16) /* Summe der Quadrate */
,2 maxX float dec (16) /* Maximum */
,2 minX float dec (16) /* Minimum */
,2 nn fixed bin (31) /* Anzahl Messungen */
,2 text char (256) varz /* Freitext */
;
define alias fTransfer_t /* Transferfunktion A1 ---> H1 */
limited entry (file variable nonasgn
,handle sqlca_t nonasgn
,char (10) byaddr nonasgn
,char (10) byaddr nonasgn
,(*) handle rtSta_t byaddr nonasgn
)
returns (byvalue fixed bin (31))
options (byvalue)
variable;
01010002
/* -Constant(s)----------------------------------------------------- */01430002
/* YXRRSAF: verwendete Befehle */
dcl cConnect char value ('CONNECT');
dcl cDisconnect char value ('DISCONNECT');
dcl cCommit char value ('COMMIT');
dcl cRollback char value ('ROLLBACK');
/* Packagename */
dcl cPkg char value (packagename ());
/* Anzahl Transfers bevor Meldung */
dcl cMsgInterval char value (50000);
/* Anzahl Transfers bevor Statistik */
dcl cStaInterval char value (-1);
/* -Module(s)------------------------------------------------------- */01430002
%xinclude YMFSU0XH; /* support */
%xinclude YMFCF0XH; /* configuration */
%xinclude YMFMI0XH; /* misc.: timer, ...*/
%include YXRRSAF; /* recoverable attach facility */
/* -Based Variable(s)----------------------------------------------- */01430002
1/* ----------------------------------------------------------------- * 00930002
¦ MF7800 ¦ 00940002
* ----------------------------------------------------------------- */00950002
MF7800: proc ($args) options (MAIN); 00960002
dcl $args char (*) var nonasgn parm;
/* innerhalb PROC PF0512 */
1/* ----------------------------------------------------------------- * 01430002
¦ DB2 Tabellendeklarationen ¦
* ----------------------------------------------------------------- */
EXEC SQL
declare @table (@schema, tmf150a1) table
%include TMF150D; /* hat Strichpunkt im Copybook */
%;
EXEC SQL
declare @table (@schema, tmf150h1) table
%include TMF150D; /* hat Strichpunkt im Copybook */
%;
01010002
/* -External(s)----------------------------------------------------- */01430002
dcl SYSPRINT file print stream output ext;
/* -Constant(s)----------------------------------------------------- */01430002
dcl cPgm char value (procedurename ());
dcl ddConf char value ('file://dd:ddconf');
/* -Module(s)------------------------------------------------------- */01430002
/* -Variable(s) (automatic storage)--------------------------------- */01430002
dcl starttimePgm type tod_t init (@getTod ()) nonasgn;
dcl startDateTime type datetime_t init (datetime ()) nonasgn;
dcl starttime type tod_t init (@getTod ());
dcl doTransfer type fTransfer_t init (doTransferVersion_1);
dcl nMsgInterval fixed bin (31) init (cMsgInterval);
dcl nStaInterval fixed bin (31) init (cStaInterval);
dcl nTransfer fixed bin (31) init (0);
dcl nStop fixed bin (31) init (-1);
dcl useVersion fixed bin (31) init (1);
dcl nFlow fixed bin (31) init (0);
dcl nn fixed bin (31);
dcl fromDate char (10) init (@dfltDate);
dcl toDate char (10) init (calcToDate ());
dcl stopped bit (1) aligned;
dcl sqlca type sqlca_t;
dcl hSqlca handle sqlca_t init (handle (sqlca));
dcl 1 ausl, /* RETD und PARMD */
%include RETURND;,
2 $@rkeyl char (4),
2 $@rkeyf char (76),
%include PARMD;,
2 $@ssid char(4), /* DB2-Subsystem */
2 $@plan char(8) /* Plan */
;
dcl hRtStaTbl (10) handle rtSta_t init ((8) null ()
,newRtSta ('transfer total')
,newRtSta ('commit'));
/* -Error-Handling-------------------------------------------------- */
%include PGMANFA;
%;
1/* -Prologue-------------------------------------------------------- */01430002
call pliretc (@cc_err); /* init: error */
put edit
((@nRep) @repChar)
(skip, a)
('Package', cPkg, 'Compiletime', @compiletime)
(skip, a, x(5), a, col(45), a, x(5), a)
('Program', cPgm)
(skip, a, x(5), a)
;
call @suppPkg (SYSPRINT);
call @printTimeAndInfo (SYSPRINT, 'entering prologue');
put skip list ((@nRep) @repChar);
/* berechne Von-Datum
* (Von- bzw. Bis-Datum kann noch überschrieben werden
* in @getConfiguration - transfer-Funktion)
*/
fromDate = calcFromDate (toDate);
/* lese Parameter (PARM-Member)
*/
%include YYCNTRL; /* enthält auch READ-call */
put edit
((@nRep) @repChar)
(skip, a)
('SSID=', $@ssid, 'Plan=', $@plan)
(skip, a, a, x(5), a, a)
((@nRep) @repChar)
(skip, a)
;
/* lese Parameter (Konfiguration)
*/
call @getConfiguration (transfer, ddConf, *, SYSPRINT);
put skip list ((@nRep) @repChar);
/* überprüfe Von-Bis-Datum
*/
call checkHistPeriod (SYSPRINT, fromDate, toDate);
put edit
('transferring flows, between', fromDate, 'and', toDate)
(skip, a, x(1), a, x(1), a, x(1), a)
;
1 /* baue Verbindung zur DB auf (establish thread)
*/
call execRRSAFCmd (SYSPRINT, cConnect, $@ssid, $@plan);
select (useVersion);
when (0) do;
put skip list ('using verion 0 (with temporary table)');
put skip list ((@nRep) @repChar);
doTransfer = doTransferVersion_0; );
hRtStaTbl (1) = newRtSta
('fill UUID in temporary table');
hRtStaTbl (2) = newRtSta ('insert flows into TMF150H1');
hRtStaTbl (3) = newRtSta ('delete flows in TMF150A1');
/* erzeuge Global Temporay Table für UUID
*/
call @printTimeAndInfo (SYSPRINT
,"declare table 'Tkey_Ver_0'");
EXEC SQL
declare global temporary table session.Tkey_Ver_1 as
(select MF150001
from @table (@schema, tmf150a1)
)
with no data
on commit delete rows
;
if ^@chkSQL (@sqlOk) then
call exitPgm (SYSPRINT,"declare table 'Tkey_Ver_0' failed"
,hSqlCa);
end;
when (1) do;
put skip list ('using verion 1 (with temporary table)');
put skip list ((@nRep) @repChar);
doTransfer = doTransferVersion_1; );
hRtStaTbl (1) = newRtSta
('fill UUID, CIF, bookingdate and OU into temporary table');
hRtStaTbl (2) = newRtSta ('insert flows into TMF150H1');
hRtStaTbl (3) = newRtSta ('delete flows in TMF150A1');
/* erzeuge Global Temporay Table für UUID, Buchungsdatum und OE
*/
call @printTimeAndInfo (SYSPRINT
,"declare table 'Tkey_Ver_1'");
EXEC SQL
declare global temporary table session.Tkey_Ver_1 as
(select MF150001
,MF150023
,MF150013
,MF150067
from @table (@schema, tmf150a1)
)
with no data
on commit delete rows
;
if ^@chkSQL (@sqlOk) then
call exitPgm (SYSPRINT,"declare table 'Tkey_Ver_1' failed"
,hSqlCa);
end;
1 when (2) do;
put skip list ('using verion 2 (select from delete - insert)');
put skip list (' ---> data shuffling');
put skip list ((@nRep) @repChar);
doTransfer = doTransferVersion_2; );
hRtStaTbl (1) =
newRtSta ('open cursor - delete flows in TMF150A1');
hRtStaTbl (2) =
newRtSta ('fetch and insert flows into TMF150H1');
hRtStaTbl (3) = newRtSta ('close cursor');
end;
when (3) do;
put skip list ("using verion 3 (walther's solution)");
put skip list ((@nRep) @repChar);
doTransfer = doTransferVersion_3; );
hRtStaTbl (1) = newRtSta
('fill bookingdate and OU into temporary table');
hRtStaTbl (2) = newRtSta ('insert flows into TMF150H1');
hRtStaTbl (3) = newRtSta ('delete flows in TMF150A1');
/* erzeuge Global Temporay Table für Buchungsdatun und OE
*/
call @printTimeAndInfo (SYSPRINT, 'declare table Tkey_Ver_3');
EXEC SQL
declare global temporary table session.Tkey_Ver_3 as
(select MF150013
,MF150067
from @table (@schema, tmf150a1)
)
with no data
on commit delete rows
;
if ^@chkSQL (@sqlOk) then
call exitPgm (SYSPRINT,"declare table 'Tkey_Ver_3' failed"
,hSqlCa);
end;
1 when (4) do;
put skip list ('using verion 4 (select from insert - delete)');
put skip list ((@nRep) @repChar);
doTransfer = doTransferVersion_4; );
hRtStaTbl (1) = newRtSta
('open cursor - insert flows in TMF150H1');
hRtStaTbl (2) = newRtSta
('fetch and delete flows in TMF150A1');
hRtStaTbl (3) = newRtSta ('fill UUID into temporary table');
hRtStaTbl (4) = newRtSta ('delete SFL in TMF150A1');
hRtStaTbl (5) = newRtSta ('close cursor');
/* erzeuge Global Temporay Table für UUID
*/
call @printTimeAndInfo (SYSPRINT
,"declare table 'Tkey_Ver_4'");
EXEC SQL
declare global temporary table session.Tkey_Ver_4 as
(select MF150001
from @table (@schema, tmf150a1)
)
with no data
on commit delete rows
;
if ^@chkSQL (@sqlOk) then
call exitPgm (SYSPRINT,"declare table 'Tkey_Ver_4' failed"
,hSqlCa);
end;
other call exitPgm (SYSPRINT, 'not a valid version specified|');
end;
call @printElapsedTime (SYSPRINT, starttime
,'ending prologue');
1/* -MAINline-------------------------------------------------------- */01430002
call @printTimeAndInfo (SYSPRINT, 'entering MAINline');
put skip list ((@nRep) @repChar);
/* counting # of flows to be transferred
*/
nFlow = #ofSFL (SYSPRINT, hSqlca, fromDate, toDate);
put edit
('# of flows expected:', nFlow)
(skip, a, col(30), p'zzz,zzz,zzz,zz9')
;
if nStop > 0 then
put edit
('ATTENTION: stopping after # of flows transferred:'
, nStop)
(skip, a, x(3), p'zzz,zzz,zzz,zz9')
;
if useVersion ^= 3 then
put edit
('transferring flows in blocks of '
,trim (edit (@blocksize, 'zzzzz9')))
(skip, a, x(1), a)
;
put skip list ((@nRep) @repChar);
/* transferring single flows: TMF150A1 ---> TMF150H1
*/
startTime = @getTod ();
nn = doTransfer (SYSPRINT, hSqlca, fromDate, toDate, hRtStaTbl);
call add2RtStat (hRtStaTbl (9), starttime);
do while (nn > 0)
until (stopped);
nTransfer += nn;
/* print message
*/
if mod (nTransfer, nMsgInterval) = 0 then
call @printTimeAndInfo (SYSPRINT
,'# of transfers --->'
|| edit (nTransfer, 'z,zzz,zzz,zz9'));
stopped = (nStop > 0 & nStop <= nTransfer);
if stopped then
put skip list ('ATTENTION: processing stopped|');
else do;
/* committing changes
*/
startTime = @getTod ();
call execRRSAFCmd (SYSPRINT, cCommit, *, *);
call add2RtStat (hRtStaTbl (10), starttime);
/* print statistics
*/
if nStaInterval > 0
& mod (nTransfer, nStaInterval) = 0 then
call printRtStaTbl (SYSPRINT, hRtStaTbl);
/* transferring single flows: TMF150A1 ---> TMF150H1
*/
startTime = @getTod ();
nn = doTransfer (SYSPRINT
,hSqlca, fromDate, toDate, hRtStaTbl);
call add2RtStat (hRtStaTbl (9), starttime);
end;
end;
put skip list ((@nRep) @repChar);
/* last commit
*/
startTime = @getTod ();
call execRRSAFCmd (SYSPRINT, cCommit, *, *);
call add2RtStat (hRtStaTbl (10), starttime);
1/* -Epilog---------------------------------------------------------- */01430002
call @printTimeAndInfo (SYSPRINT, 'entering epilogue');
put skip list ((@nRep) @repChar);
put edit
('Program - Statistics', (@nRep) @repChar)
(skip, a, skip, a)
(' Expected flow(s)', nFlow)
(skip, a, col(30), p'zzz,zzz,zzz,zz9')
(' Transfer(s)', nTransfer)
(skip, a, col(30), p'zzz,zzz,zzz,zz9')
(' Blocksize', @blocksize)
(skip, a, col(30), p'zzz,zzz,zzz,zz9')
;
/* drucke Runtime-Statistik aus
* und rufe Destruktoren auf: gebe Heap-Memory frei
*/
call printRtStaTbl (SYSPRINT, hRtStaTbl);
call deleteRtStaTbl (hRtStaTbl);
/* baue Verbindung zur DB ab (also commits changes)
*/
call execRRSAFCmd (SYSPRINT, cDisconnect, *, *);
/* Zeitmessung (elpased time)
*/
call @printStartEndTime (SYSPRINT, startDateTime);
call @printElapsedTime (SYSPRINT, starttimePgm, 'program');
close file (*);
/* Condition Code
*/
call pliretc (@cc_ok); /* ok */
1/* ----------------------------------------------------------------- *
¦ Prozeduren/Funktionen INTERN ¦
* ----------------------------------------------------------------- */
/* -transfer 'getConfiguration'------------------------------Level 2 */
transfer: proc ($type, $name, $value)
options (nodescriptor);
dcl $type type cf_t parm;
dcl $name type cf_name_t nonasgn parm;
dcl $value type cf_name_t nonasgn optional parm;
dcl nn fixed bin (31);
dcl dateTmp char (10);
if $type ^= cf_parameter then return; /* falscher Typ */
if omitted ($value) then return; /* kein Wert angegeben */
if length ($value) = 0 then return; /* kein Wert mitgegeben */
/* Parameter(s) (Name/Value Pair)
*/
select (lowercase ($name));
/* use version
*/
when ('use-version') do;
nn = @char2Int ($value);
if nn > 0 & nn < 5 then useVersion = nn;
end;
/* use this from date
*/
when ('from-date') do;
dateTmp = $value;
if validdate (dateTmp, @dateFmt) then p;
fromDate = dateTmp; p;
end;
/* use this to date
*/
when ('to-date') do;
dateTmp = $value;
if validdate (dateTmp, @dateFmt) then p;
toDate = dateTmp; p;
end;
/* print message to SYSPRINT after # of SFLs transfered
*/
when ('print-msg-after-#sfl') do;
nn = @char2Int ($value);
if nn > 0 then nMsgInterval = nn;
end;
/* print statistcs SYSPRINT after # of SFLs transfered
*/
when ('print-sta-after-#sfl') do;
nn = @char2Int ($value);
if nn > 0 then nStaInterval = nn;
end;
/* stop processing after # of SFLs transfered
*/
when ('stop-after-#sfl') do;
nn = @char2Int ($value);
if nn > 0 then nStop = nn;
end;
other;
end;
end transfer;
end MF7800; 07640002
1/* ----------------------------------------------------------------- * 01430002
¦ Prozeduren/Funktionen EXTERN ¦
* ----------------------------------------------------------------- */
/* -transfer SFL TMF150A1 --> TMF150H1-----------------------Level 1 */
doTransferVersion_0: proc ($ddPrint
,$hSqlCa, $fromDate, $toDate, $hRtStaTbl)
returns (byvalue fixed bin (31))
options (byvalue);
dcl $ddPrint file variable nonasgn parm; /* Printstream */
dcl $hSqlca handle sqlca_t nonasgn parm; /* SQLCA */
dcl $fromDate char (10) byaddr nonasgn parm;
dcl $toDate char (10) byaddr nonasgn parm;
dcl $hRtStaTbl (*) handle rtSta_t byaddr nonasgn parm;
dcl fromDate_a char (10) init ($fromDate);
dcl toDate_a char (10) init ($toDate);
dcl starttime type tod_t;
dcl sqlca type sqlca_t based (ptrvalue ($hSqlCa));
starttime = @getTod ();
EXEC SQL
insert into session.Tkey_Ver_1
(mf150001
)
select MF150001 from @table (@schema, tmf150a1)
where MF150013 between :fromDate_a
and :toDate_a
order by MF150013
,MF150067
fetch first @blocksize rows only
;
if ^(@chkSql (@sqlOk)
| @chkSql (@sqlNoData)) then
call exitPgm ($ddPrint
,"insert 'session.Tkey_Ver_1' failed"
,$hSqlCa);
call add2RtStat ($hRtStaTbl (1), starttime);
if @chkSql (@sqlNoData) then return (0);
1 starttime = @getTod ();
EXEC SQL
insert into @table (@schema, tmf150h1)
(MF150001, MF150002, MF150003, MF150004, MF150005, MF150006
,MF150007, MF150008, MF150009, MF150010, MF150011, MF150012
,MF150013, MF150014, MF150015, MF150016, MF150017, MF150018
,MF150019, MF150020, MF150021, MF150022, MF150023, MF150024
,MF150025, MF150026, MF150027, MF150028, MF150029, MF150030
,MF150031, MF150032, MF150033, MF150034, MF150035, MF150036
,MF150037, MF150038, MF150039, MF150040, MF150041, MF150042
,MF150043, MF150044, MF150045, MF150046, MF150047, MF150051
,MF150052, MF150053, MF150054, MF150055, MF150056, MF150059
,MF150060, MF150062, MF150063, MF150064, MF150065, MF150066
,MF150067, MF150068, MF150069, MF150070, MF150071, MF150072
,MF150073, MF150074, MF150075, MF150076, MF150077, MF150078
,MF150079, MF150080, MF150081, MF150082, MF150083, MF150084
,MF150085, MF150086, MF150087, MF150088, MF150089, MF150090
,MF150091, MF150092, MF150019A)
select
MF150001, MF150002, MF150003, MF150004, MF150005, MF150006
,MF150007, MF150008, MF150009, MF150010, MF150011, MF150012
,MF150013, MF150014, MF150015, MF150016, MF150017, MF150018
,MF150019, MF150020, MF150021, MF150022, MF150023, MF150024
,MF150025, MF150026, MF150027, MF150028, MF150029, MF150030
,MF150031, MF150032, MF150033, MF150034, MF150035, MF150036
,MF150037, MF150038, MF150039, MF150040, MF150041, MF150042
,MF150043, MF150044, MF150045, MF150046, MF150047, MF150051
,MF150052, MF150053, MF150054, MF150055, MF150056, MF150059
,MF150060, MF150062, MF150063, MF150064, MF150065, MF150066
,MF150067, MF150068, MF150069, MF150070, MF150071, MF150072
,MF150073, MF150074, MF150075, MF150076, MF150077, MF150078
,MF150079, MF150080, MF150081, MF150082, MF150083, MF150084
,MF150085, MF150086, MF150087, MF150088, MF150089, MF150090
,MF150091, MF150092, MF150019A
from @table (@schema, tmf150a1)
where MF150001 in
(select MF150001 from session.Tkey_Ver_1)
;
if ^@chkSql (@sqlOk) then
call exitPgm ($ddPrint
,"insert into 'TMF150H1' failed"
,$hSqlCa);
call add2RtStat ($hRtStaTbl (2), starttime);
starttime = @getTod ();
EXEC SQL
delete from @table (@schema, tmf150a1) a
where MF150001 in
(select MF150001 from session.Tkey_Ver_1)
;
if ^@chkSql (@sqlOk) then
call exitPgm ($ddPrint
,"delete flows in 'TMF150A1' failed"
,$hSqlCa);
call add2RtStat ($hRtStaTbl (3), starttime);
return (sqlca.sqlerrd (3)); /* # of deletes in TMF150A1 */
end doTransferVersion_0;
1/* -transfer SFL TMF150A1 --> TMF150H1-----------------------Level 1 */
doTransferVersion_1: proc ($ddPrint
,$hSqlCa, $fromDate, $toDate, $hRtStaTbl)
returns (byvalue fixed bin (31))
options (byvalue);
dcl $ddPrint file variable nonasgn parm; /* Printstream */
dcl $hSqlca handle sqlca_t nonasgn parm; /* SQLCA */
dcl $fromDate char (10) byaddr nonasgn parm;
dcl $toDate char (10) byaddr nonasgn parm;
dcl $hRtStaTbl (*) handle rtSta_t byaddr nonasgn parm;
dcl fromDate_a char (10) init ($fromDate);
dcl toDate_a char (10) init ($toDate);
dcl starttime type tod_t;
dcl sqlca type sqlca_t based (ptrvalue ($hSqlCa));
starttime = @getTod ();
EXEC SQL
insert into session.Tkey_Ver_1
(mf150001
,mf150023
,mf150013
,mf150067)
select MF150001
,MF150023
,MF150013
,MF150067 from @table (@schema, tmf150a1)
where MF150013 >= :fromDate_a
and MF150013 <= :toDate_a
order by MF150013
,MF150067
fetch first @blocksize rows only
;
if ^(@chkSql (@sqlOk)
| @chkSql (@sqlNoData)) then
call exitPgm ($ddPrint
,"insert 'session.Tkey_Ver_1' failed"
,$hSqlCa);
call add2RtStat ($hRtStaTbl (1), starttime);
if @chkSql (@sqlNoData) then return (0);
1 starttime = @getTod ();
EXEC SQL
insert into @table (@schema, tmf150h1)
(MF150001, MF150002, MF150003, MF150004, MF150005, MF150006
,MF150007, MF150008, MF150009, MF150010, MF150011, MF150012
,MF150013, MF150014, MF150015, MF150016, MF150017, MF150018
,MF150019, MF150020, MF150021, MF150022, MF150023, MF150024
,MF150025, MF150026, MF150027, MF150028, MF150029, MF150030
,MF150031, MF150032, MF150033, MF150034, MF150035, MF150036
,MF150037, MF150038, MF150039, MF150040, MF150041, MF150042
,MF150043, MF150044, MF150045, MF150046, MF150047, MF150051
,MF150052, MF150053, MF150054, MF150055, MF150056, MF150059
,MF150060, MF150062, MF150063, MF150064, MF150065, MF150066
,MF150067, MF150068, MF150069, MF150070, MF150071, MF150072
,MF150073, MF150074, MF150075, MF150076, MF150077, MF150078
,MF150079, MF150080, MF150081, MF150082, MF150083, MF150084
,MF150085, MF150086, MF150087, MF150088, MF150089, MF150090
,MF150091, MF150092, MF150019A)
select
MF150001, MF150002, MF150003, MF150004, MF150005, MF150006
,MF150007, MF150008, MF150009, MF150010, MF150011, MF150012
,MF150013, MF150014, MF150015, MF150016, MF150017, MF150018
,MF150019, MF150020, MF150021, MF150022, MF150023, MF150024
,MF150025, MF150026, MF150027, MF150028, MF150029, MF150030
,MF150031, MF150032, MF150033, MF150034, MF150035, MF150036
,MF150037, MF150038, MF150039, MF150040, MF150041, MF150042
,MF150043, MF150044, MF150045, MF150046, MF150047, MF150051
,MF150052, MF150053, MF150054, MF150055, MF150056, MF150059
,MF150060, MF150062, MF150063, MF150064, MF150065, MF150066
,MF150067, MF150068, MF150069, MF150070, MF150071, MF150072
,MF150073, MF150074, MF150075, MF150076, MF150077, MF150078
,MF150079, MF150080, MF150081, MF150082, MF150083, MF150084
,MF150085, MF150086, MF150087, MF150088, MF150089, MF150090
,MF150091, MF150092, MF150019A
from @table (@schema, tmf150a1)
where MF150001 in
(select MF150001 from session.Tkey_Ver_1
order by MF150013
,MF150067)
;
if ^@chkSql (@sqlOk) then
call exitPgm ($ddPrint
,"insert into 'TMF150H1' failed"
,$hSqlCa);
call add2RtStat ($hRtStaTbl (2), starttime);
starttime = @getTod ();
EXEC SQL
delete from @table (@schema, tmf150a1) a
where (MF150023
,MF150013) in
(select MF150023
,MF150013 from session.Tkey_Ver_1)
and MF150001 in
(select MF150001 from session.Tkey_Ver_1)
;
if ^@chkSql (@sqlOk) then
call exitPgm ($ddPrint
,"delete flows in 'TMF150A1' failed"
,$hSqlCa);
call add2RtStat ($hRtStaTbl (3), starttime);
return (sqlca.sqlerrd (3)); /* # of deletes in TMF150A1 */
end doTransferVersion_1;
1/* -transfer SFL TMF150A1 --> TMF150H1-----------------------Level 1 */
doTransferVersion_2: proc ($ddPrint
,$hSqlCa, $fromDate, $toDate, $hRtStaTbl)
returns (byvalue fixed bin (31))
options (byvalue);
dcl $ddPrint file variable nonasgn parm; /* Printstream */
dcl $hSqlca handle sqlca_t nonasgn parm; /* SQLCA */
dcl $fromDate char (10) byaddr nonasgn parm;
dcl $toDate char (10) byaddr nonasgn parm;
dcl $hRtStaTbl (*) handle rtSta_t byaddr nonasgn parm;
dcl nn fixed bin (31) init (0);
dcl fromDate_b char (10) init ($fromDate);
dcl toDate_b char (10) init ($toDate);
dcl starttime type tod_t;
dcl 1 ioT150_b,
%include TMF150P; /* hat Strichpunkt im Copybook */
dcl sqlca type sqlca_t based (ptrvalue ($hSqlCa));
EXEC SQL
declare cur_getAndDelete_b cursor for
select
MF150001, MF150002, MF150003, MF150004, MF150005, MF150006
,MF150007, MF150008, MF150009, MF150010, MF150011, MF150012
,MF150013, MF150014, MF150015, MF150016, MF150017, MF150018
,MF150019, MF150020, MF150021, MF150022, MF150023, MF150024
,MF150025, MF150026, MF150027, MF150028, MF150029, MF150030
,MF150031, MF150032, MF150033, MF150034, MF150035, MF150036
,MF150037, MF150038, MF150039, MF150040, MF150041, MF150042
,MF150043, MF150044, MF150045, MF150046, MF150047, MF150051
,MF150052, MF150053, MF150054, MF150055, MF150056, MF150059
,MF150060, MF150062, MF150063, MF150064, MF150065, MF150066
,MF150067, MF150068, MF150069, MF150070, MF150071, MF150072
,MF150073, MF150074, MF150075, MF150076, MF150077, MF150078
,MF150079, MF150080, MF150081, MF150082, MF150083, MF150084
,MF150085, MF150086, MF150087, MF150088, MF150089, MF150090
,MF150091, MF150092, MF150019A
from old table
(delete from @table (@schema, tmf150a1) a
where a.MF150001 in
(select b.MF150001
from @table (@schema, tmf150a1) b
where b.MF150013 >= :fromDate_b
and b.MF150013 <= :toDate_b
order by MF150013
,MF150067
fetch first @blocksize rows only
)
)
order by MF150013
,MF150067
;
1 starttime = @getTod ();
EXEC SQL
open cur_getAndDelete_b;
if ^@chkSql (@sqlOk) then
call exitPgm ($ddPrint
,"open cursor 'cur_getAndDelete_b' failed"
,$hSqlCa);
call add2RtStat ($hRtStaTbl (1), starttime);
starttime = @getTod ();
do while (getData ());
EXEC SQL
insert into @table (@schema, tmf150h1)
values (:ioT150_b)
;
if ^(@chkSql (@sqlOk)
| @chkSql (@sqlDuplicate)) then
call exitPgm ($ddPrint
,"insert flows into 'TMF150H1' failed"
,$hSqlCa);
nn += 1;
end;
call add2RtStat ($hRtStaTbl (2), starttime);
starttime = @getTod ();
EXEC SQL
close cur_getAndDelete_b;
if ^@chkSql (@sqlOk) then
call exitPgm ($ddPrint
,"close cursor 'cur_getAndDelete_b' failed"
,$hSqlCa);
call add2RtStat ($hRtStaTbl (3), starttime);
return (nn);
/* -lese Daten ein------------------------------------------Level 2- */
getData: proc returns (byvalue bit (1) aligned);
EXEC SQL
fetch cur_getAndDelete_b
into :ioT150_b
;
if @chkSql (@sqlOk) then return (@true);
if @chkSql (@sqlNodata) then return (@false);
call exitPgm ($ddPrint
,"fetch cursor 'cur_getAndDelete_b' failed"
,$hSqlCa);
end getData;
end doTransferVersion_2;
1/* -transfer SFL TMF150A1 --> TMF150H1-----------------------Level 1 */
doTransferVersion_3: proc ($ddPrint
,$hSqlCa, $fromDate, $toDate, $hRtStaTbl)
returns (byvalue fixed bin (31))
options (byvalue);
dcl $ddPrint file variable nonasgn parm; /* Printstream */
dcl $hSqlca handle sqlca_t nonasgn parm; /* SQLCA */
dcl $fromDate char (10) byaddr nonasgn parm;
dcl $toDate char (10) byaddr nonasgn parm;
dcl $hRtStaTbl (*) handle rtSta_t byaddr nonasgn parm;
dcl fromDate_c char (10) init ($fromDate);
dcl toDate_c char (10) init ($toDate);
dcl starttime type tod_t;
dcl sqlca type sqlca_t based (ptrvalue ($hSqlCa));
starttime = @getTod ();
EXEC SQL
insert into session.Tkey_Ver_3
(mf150013
,mf150067)
select MF150013
,MF150067 from
(select MF150013
,MF150067 from @table (@schema, tmf150a1)
where MF150013 >= :fromDate_c
and MF150013 <= :toDate_c
fetch first @blocksize_3 rows only
) i
group by MF150013
,MF150067
;
if ^(@chkSql (@sqlOk)
| @chkSql (@sqlNoData)) then
call exitPgm ($ddPrint
,"insert into 'session.Tkey_Ver_3' failed"
,$hSqlCa);
call add2RtStat ($hRtStaTbl (1), starttime);
if @chkSql (@sqlNoData) then return (0);
1 starttime = @getTod ();
EXEC SQL
insert into @table (@schema, tmf150h1)
(MF150001, MF150002, MF150003, MF150004, MF150005, MF150006
,MF150007, MF150008, MF150009, MF150010, MF150011, MF150012
,MF150013, MF150014, MF150015, MF150016, MF150017, MF150018
,MF150019, MF150020, MF150021, MF150022, MF150023, MF150024
,MF150025, MF150026, MF150027, MF150028, MF150029, MF150030
,MF150031, MF150032, MF150033, MF150034, MF150035, MF150036
,MF150037, MF150038, MF150039, MF150040, MF150041, MF150042
,MF150043, MF150044, MF150045, MF150046, MF150047, MF150051
,MF150052, MF150053, MF150054, MF150055, MF150056, MF150059
,MF150060, MF150062, MF150063, MF150064, MF150065, MF150066
,MF150067, MF150068, MF150069, MF150070, MF150071, MF150072
,MF150073, MF150074, MF150075, MF150076, MF150077, MF150078
,MF150079, MF150080, MF150081, MF150082, MF150083, MF150084
,MF150085, MF150086, MF150087, MF150088, MF150089, MF150090
,MF150091, MF150092, MF150019A)
select
MF150001, MF150002, MF150003, MF150004, MF150005, MF150006
,MF150007, MF150008, MF150009, MF150010, MF150011, MF150012
,MF150013, MF150014, MF150015, MF150016, MF150017, MF150018
,MF150019, MF150020, MF150021, MF150022, MF150023, MF150024
,MF150025, MF150026, MF150027, MF150028, MF150029, MF150030
,MF150031, MF150032, MF150033, MF150034, MF150035, MF150036
,MF150037, MF150038, MF150039, MF150040, MF150041, MF150042
,MF150043, MF150044, MF150045, MF150046, MF150047, MF150051
,MF150052, MF150053, MF150054, MF150055, MF150056, MF150059
,MF150060, MF150062, MF150063, MF150064, MF150065, MF150066
,MF150067, MF150068, MF150069, MF150070, MF150071, MF150072
,MF150073, MF150074, MF150075, MF150076, MF150077, MF150078
,MF150079, MF150080, MF150081, MF150082, MF150083, MF150084
,MF150085, MF150086, MF150087, MF150088, MF150089, MF150090
,MF150091, MF150092, MF150019A
from @table (@schema, tmf150a1)
where (MF150013
,MF150067) in
(select MF150013
,MF150067 from session.Tkey_Ver_3)
;
if ^@chkSql (@sqlOk) then
call exitPgm ($ddPrint
,"insert flow into 'TMF150H1' failed"
,$hSqlCa);
call add2RtStat ($hRtStaTbl (2), starttime);
starttime = @getTod ();
EXEC SQL
delete from @table (@schema, tmf150a1)
where (MF150013
,MF150067) in
(select MF150013
,MF150067 from session.Tkey_Ver_3)
;
if ^@chkSql (@sqlOk) then
call exitPgm ($ddPrint
,"delete flows in 'TMF150A1' failed"
,$hSqlCa);
call add2RtStat ($hRtStaTbl (3), starttime);
return (sqlca.sqlerrd (3)); /* # of deletes in TMF150A1 */
end doTransferVersion_3;
1/* -transfer SFL TMF150A1 --> TMF150H1-----------------------Level 1 */
doTransferVersion_4: proc ($ddPrint
,$hSqlCa, $fromDate, $toDate, $hRtStaTbl)
returns (byvalue fixed bin (31))
options (byvalue);
dcl $ddPrint file variable nonasgn parm; /* Printstream */
dcl $hSqlca handle sqlca_t nonasgn parm; /* SQLCA */
dcl $fromDate char (10) byaddr nonasgn parm;
dcl $toDate char (10) byaddr nonasgn parm;
dcl $hRtStaTbl (*) handle rtSta_t byaddr nonasgn parm;
dcl nn fixed bin (31) init (0);
dcl nRow fixed bin (31);
dcl is@End bit (1) aligned init (@false);
dcl fromDate_d char (10) init ($fromDate);
dcl toDate_d char (10) init ($toDate);
dcl starttime type tod_t;
dcl starttime_i type tod_t;
dcl uuidTbl (@blocksize) char (16) init ((@blocksize)(''));
dcl sqlca type sqlca_t based (ptrvalue ($hSqlCa));
EXEC SQL
declare cur_getAndInsert_d cursor
with rowset positioning for
select MF150001 from final table (
insert into @table (@schema, tmf150h1)
(MF150001, MF150002, MF150003, MF150004, MF150005, MF150006
,MF150007, MF150008, MF150009, MF150010, MF150011, MF150012
,MF150013, MF150014, MF150015, MF150016, MF150017, MF150018
,MF150019, MF150020, MF150021, MF150022, MF150023, MF150024
,MF150025, MF150026, MF150027, MF150028, MF150029, MF150030
,MF150031, MF150032, MF150033, MF150034, MF150035, MF150036
,MF150037, MF150038, MF150039, MF150040, MF150041, MF150042
,MF150043, MF150044, MF150045, MF150046, MF150047, MF150051
,MF150052, MF150053, MF150054, MF150055, MF150056, MF150059
,MF150060, MF150062, MF150063, MF150064, MF150065, MF150066
,MF150067, MF150068, MF150069, MF150070, MF150071, MF150072
,MF150073, MF150074, MF150075, MF150076, MF150077, MF150078
,MF150079, MF150080, MF150081, MF150082, MF150083, MF150084
,MF150085, MF150086, MF150087, MF150088, MF150089, MF150090
,MF150091, MF150092, MF150019A)
select
MF150001, MF150002, MF150003, MF150004, MF150005, MF150006
,MF150007, MF150008, MF150009, MF150010, MF150011, MF150012
,MF150013, MF150014, MF150015, MF150016, MF150017, MF150018
,MF150019, MF150020, MF150021, MF150022, MF150023, MF150024
,MF150025, MF150026, MF150027, MF150028, MF150029, MF150030
,MF150031, MF150032, MF150033, MF150034, MF150035, MF150036
,MF150037, MF150038, MF150039, MF150040, MF150041, MF150042
,MF150043, MF150044, MF150045, MF150046, MF150047, MF150051
,MF150052, MF150053, MF150054, MF150055, MF150056, MF150059
,MF150060, MF150062, MF150063, MF150064, MF150065, MF150066
,MF150067, MF150068, MF150069, MF150070, MF150071, MF150072
,MF150073, MF150074, MF150075, MF150076, MF150077, MF150078
,MF150079, MF150080, MF150081, MF150082, MF150083, MF150084
,MF150085, MF150086, MF150087, MF150088, MF150089, MF150090
,MF150091, MF150092, MF150019A
from @table (@schema, tmf150a1) a
where (a.MF150001
,a.MF150013
,a.MF150067) in
(select b.MF150001
,b.MF150013
,b.MF150067
from @table (@schema, tmf150a1) b
where b.MF150013 >= :fromDate_d
and b.MF150013 <= :toDate_d
order by b.MF150013
,b.MF150067
fetch first @blocksize rows only
)
) order by input sequence
;
1 starttime = @getTod ();
EXEC SQL
open cur_getAndInsert_d;
if ^@chkSql (@sqlOk) then
call exitPgm ($ddPrint
,"open cursor 'cur_getAndInsert_d' failed"
,$hSqlCa);
call add2RtStat ($hRtStaTbl (1), starttime);
starttime = @getTod ();
nRow = getData (is@End);
do while (nRow > 0);
/* insert UUID into session table
*/
starttime_i = @getTod ();
EXEC SQL
insert into session.Tkey_Ver_4
values (:uuidTbl)
for :nRow rows
;
if ^@chkSql (@sqlOk) then
call exitPgm ($ddPrint
,'insert into session.Tkey_Ver_4 failed'
,$hSqlCa);
call add2RtStat ($hRtStaTbl (3), starttime_i);
/* delete flows in TMF150A1
*/
starttime_i = @getTod ();
EXEC SQL
delete from @table (@schema, tmf150a1)
where MF150001 in
(select MF150001 from session.Tkey_Ver_4)
;
if ^@chkSql (@sqlOk) then
call exitPgm ($ddPrint
,"delete flows in 'TMF150A1' failed"
,$hSqlCa);
call add2RtStat ($hRtStaTbl (4), starttime_i);
nn += nRow;
if is@End then nRow = 0; /* no more data */
else nRow = getData (is@End);
end;
call add2RtStat ($hRtStaTbl (2), starttime);
starttime = @getTod ();
EXEC SQL
close cur_getAndInsert_d;
if ^@chkSql (@sqlOk) then
call exitPgm ($ddPrint
,"close cursor 'cur_getAndInsert_d' failed"
,$hSqlCa);
call add2RtStat ($hRtStaTbl (5), starttime);
return (nn);
/* -lese Daten ein------------------------------------------Level 2- */
getData: proc ($is@End)
returns (byvalue fixed bin (31));
dcl $is@End bit (1) aligned;
EXEC SQL
fetch next rowset from cur_getAndInsert_d
for @blocksize rows
into :uuidTbl
;
if ^(@chkSql (@sqlOk)
| @chkSql (@sqlNoData)) then
call exitPgm ($ddPrint
,"fetch cursor 'cur_getAndInsert_d' failed"
,$hSqlCa);
$is@End = (@chkSql (@sqlNoData));
return (sqlca.sqlerrd (3)); /* # of rows in rowset */
end getData;
end doTransferVersion_4;
1/* -commit changes-------------------------------------------Level 1 */
#ofSFL: proc ($ddPrint, $hSqlca, $fromDate, $toDate)
options (byvalue)
returns (byvalue fixed bin (31));
dcl $ddPrint file variable byvalue nonasgn parm;
dcl $hSqlca handle sqlca_t nonasgn parm; /* SQLCA */
dcl $fromDate char (10) byaddr nonasgn parm;
dcl $toDate char (10) byaddr nonasgn parm;
dcl nn_c fixed bin (31) init (0);
dcl fromDate_z char (10) init ($fromDate);
dcl toDate_z char (10) init ($toDate);
dcl starttime type tod_t init (@getTod ());
dcl sqlca type sqlca_t based (ptrvalue ($hSqlCa));
EXEC SQL
select count (*)
into :nn_c
from @table (@schema, tmf150a1)
where MF150013 >= :fromDate_z
and MF150013 <= :toDate_z
with ur
;
if @chkSql (@sqlOk) then do;
call @printElapsedTime ($ddPrint, starttime
,"select 'count (*)'");
return (nn_c);
end;
call exitPgm ($ddPrint
,"select 'count (*)' failed"
,$hSqlCa);
end #ofSFL;
/* -commit changes-------------------------------------------Level 1 */
execRRSAFCmd: proc ($ddPrint, $cmd, $ssid, $plan)
options (byvalue);
dcl $ddPrint file variable byvalue nonasgn parm;
dcl $cmd char (12) byaddr parm;
dcl $ssid char (4) byaddr optional parm;
dcl $plan char (8) byaddr optional parm;
dcl rc fixed bin (31);
if $cmd = cConnect then rc = YXRRSAF ($cmd, $ssid, $plan);
else rc = YXRRSAF ($cmd);
if rc ^= 0 then
call exitPgm ($ddPrint
,"YXRRSAF: "
|| $cmd
|| " failed (RC=x'"
|| hex (rc)
|| "')"
);
end execRRSAFCmd;
1/* -calculate to-date----------------------------------------Level 1 */
calcToDate: proc
returns (char (10));
dcl nDays fixed bin (31) init ((days () - 365));
dcl ii fixed bin (31);
do ii = 1 to 7;
if weekday (nDays) = 1 then /* Sunday */
return (daystodate (nDays, @dateFmt));
nDays -= 1;
end;
return ('01.01.0001');
end calcToDate;
/* -calculate from-date--------------------------------------Level 1 */
calcFromDate: proc ($toDate)
returns (char (10));
dcl $toDate char (10) nonasgn parm;
dcl nDays fixed bin (31) init (days ($toDate, @dateFmt));
return (daystodate (nDays - 6, @dateFmt));
end calcFromDate;
/* -check period---------------------------------------------Level 1 */
checkHistPeriod: proc ($ddPrint, $fromDate, $toDate);
dcl $ddPrint file variable;
dcl $fromDate char (10) nonasgn parm;
dcl $toDate char (10) nonasgn parm;
if days ($fromDate, @dateFmt) <= days ($toDate, @dateFmt) then
return;
call exitPgm ($ddPrint
,'from-date '
|| $fromDate
|| ' greater then to-date '
|| $toDate
);
end checkHistPeriod;
1/* -new runtime statistics container-------------------------Level 1 */
newRtSta: proc ($text)
returns (byvalue handle rtSta_t);
dcl hRtStat handle rtSta_t init (new (:rtSta_t:)) nonasgn;
dcl $text char (*) varz;
call plifill (ptrvalue (hRtStat), '00'x, size (:rtSta_t:));
hRtStat=>sumX = 0.0;
hRtStat=>sumX2 = 0.0;
hRtStat=>minX = huge (hRtStat=>minX);
hRtStat=>maxX = 0.0;
hRtStat=>text = $text;
return (hRtStat);
end newRtSta;
/* add sample to runtime statistics--------------------------Level 1 */
add2RtStat: proc ($hRtStat, $tod)
options (byvalue inline);
dcl $hRtStat handle rtSta_t nonasgn parm;
dcl $tod type tod_t byaddr nonasgn parm;
call addSample2RtStat ($hRtStat, @calcTodDiff (@getTod (), $tod));
end add2RtStat;
/* add sample to runtime statistics--------------------------Level 1 */
addSample2RtStat: proc ($hRtStat, $sampleX)
options (byvalue);
dcl $hRtStat handle rtSta_t nonasgn parm;
dcl $sampleX float dec (16) nonasgn parm;
$hRtStat=>sumX += $sampleX;
$hRtStat=>sumX2 += $sampleX * $sampleX;
if $sampleX > $hRtStat=>maxX then $hRtStat=>maxX = $sampleX;
if $sampleX < $hRtStat=>minX then $hRtStat=>minX = $sampleX;
$hRtStat=>nn += 1;
end addSample2RtStat;
1/* print runtime statistics----------------------------------Level 1 */
printRtStat: proc ($ddPrint, $hRtStat)
options (byvalue);
dcl $ddPrint file variable nonasgn parm;
dcl $hRtStat handle rtSta_t nonasgn parm;
dcl covariance float dec (16) init (0.0);
dcl deviation float dec (16) init (0.0);
dcl mean float dec (16) init (0.0);
if $hRtStat=>nn > 1 then do;
/* calculate covariance (Varianz)
*/
covariance = ($hRtStat=>sumX2 -
($hRtStat=>sumX * $hRtStat=>sumX /
float ($hRtStat=>nn, 16))) /
float (($hRtStat=>nn - 1), 16);
/* calculate standard deviation (Standardabweichung)
*/
deviation = sqrt (covariance);
end;
/* calculate mean (Mittelwert)
*/
if $hRtStat=>nn > 0 then
mean = $hRtStat=>sumX / float ($hRtStat=>nn, 16);
put file ($ddPrint) edit
('Runtime statistic - ', $hRtStat=>text)
(skip, a, a)
('# of samples', $hRtStat=>nn)
(skip, a, col(30), p'zzz,zzz,zz9')
('minimum', round ($hRtStat=>minX, 3))
(skip, a, col(30), p'zzz,zzz,zz9V.999')
('maximum', round ($hRtStat=>maxX, 3))
(skip, a, col(30), p'zzz,zzz,zz9V.999')
('deviation', round (deviation, 3))
(skip, a, col(30), p'zzz,zzz,zz9V.999')
('covariance', round (covariance, 3))
(skip, a, col(30), p'zzz,zzz,zz9V.999')
('mean', round (mean, 3))
(skip, a, col(30), p'zzz,zzz,zz9V.999')
;
end printRtStat;
1/* print runtime statistics table----------------------------Level 1 */
printRtStaTbl: proc ($ddPrint, $hRtStaTbl)
options (byvalue);
dcl $ddPrint file variable nonasgn parm;
dcl $hRtStaTbl (*) handle rtSta_t nonasgn parm;
dcl ii fixed bin (31);
do ii = lbound ($hRtStaTbl) to hbound ($hRtStaTbl);
if $hRtStaTbl (ii) ^= null () then do;
put skip file ($ddPrint) list ((@nRep) @repChar);
call printRtStat ($ddPrint, $hRtStaTbl (ii));
end;
end;
put skip file ($ddPrint) list ((@nRep) @repChar);
end printRtStaTbl; 07640002
/* delete runtime statistics table---------------------------Level 1 */
deleteRtStaTbl: proc ($hRtStaTbl)
options (byvalue);
dcl $hRtStaTbl (*) handle rtSta_t nonasgn parm;
dcl ii fixed bin (31);
do ii = lbound ($hRtStaTbl) to hbound ($hRtStaTbl);
if $hRtStaTbl (ii) ^= null () then
call plidelete ($hRtStaTbl (ii));
end;
end deleteRtStaTbl; 07640002
end MFR_sfl_history; 07640002
/* -CS-KGCG 21----------------------------------------------------- */07650002
}¢--- A540769.WK.PLB(QZCDPUT) cre= mod=-. --------------------------------------
*process RULES(LAXSEMI); /* suppress semicolon-warning */
*process RULES(BYNAME) ; /* allow "by name" */
*process RULES(NOLAXIF); /* suppress conversion in boolean expression */
/**** ***************************************************************/
/* QZCDPUT = test version fuer performance test von YCDPUT3 */
/* */
/* Letzte Source-Änderung: 02. Oct. 2013 14:00 A959103 */
/* */
/********************************************************************/
/* */
/* Autor : Markus Niederhauser */
/* Datum : 18.01.2001 */
/* */
/*********************************************************************/
QZCDPUT: proc($parm) options(main);
%include pgmanfa;
dcl $parm char(80) varying;
dcl fun char(1);
dcl pliRetv builtin ;
/*********************************************************************/
/* Change-Log MDL095 2008-02-14 */
/*********************************************************************/
/* */
/*-------------------------------------------------------------------*/
/* Release Req./Ticket PID Text */
/*-------------------------------------------------------------------*/
/* Z1311080 PR014104JI-29 A959103 add CD57 getCifsLong_4.0 */
/* Z1308090 PRQ1348 A959103 add CA59 & CA60 */
/* PRQ1348 A727897 add RM38 */
/*-------------------------------------------------------------------*/
/* Z1305100 PRQ1262 A393014 add RM36 + RM37 */
/*-------------------------------------------------------------------*/
/* Z1302080 PRQ1123 A393014 Maintaining clientIds */
/* */
/* PRQ1123 mn@20121115 Markus Niederhauser */
/* add CD56 */
/* CD56: IF getCifsLong_3.0 */
/* PRQ1123 ad@20121220 Andreas Dahinden */
/* CA14, CI74: YYAUPRE changed to YCDAURA */
/*-------------------------------------------------------------------*/
/* Z1211090 PRQ1026 A393014 Maintaining clientIds */
/* */
/* PRQ1026 mn@20120913 Markus Niederhauser */
/* if clientId='' then ignore comparison */
/* PRQ1026 mn@20120718 Markus Niederhauser */
/* CA37, CA38, CA39 & CA40 add - YCDGETB */
/* - YCDOEFU */
/*-------------------------------------------------------------------*/
/* Z1208100 PRQ882 A393014 CA37, CA38 & CA39 add YCDGETB */
/* */
/* PRQ882 mn@20120608 Markus Niederhauser */
/* CA37, CA38 & CA39 add YCDGETB */
/*-------------------------------------------------------------------*/
/* Z1205110 PRQ757 A393014 CI70 maxAllowedInputSeq= 600¦ */
/* Z1205110 PRQ771 A959103 CD55 IF getCifsLong_2.0 */
/* Z1205110 PRQ770 A959103 CA14 IF searchCif_2.0 */
/* */
/* PRQ628 mn@20111024 Markus Niederhauser */
/* CI70: maxAllowedInputSeq= 600¦ */
/* PRQ771 ad@20120229 Andreas Dahinden */
/* CD55: IF getCifsLong_2.0 */
/* PRQ770 ad@20120229 Andreas Dahinden */
/* CA14: IF searchCif_2.0 */
/*-------------------------------------------------------------------*/
/* Z1202100 PRQ628 A393014 crm4rmicMaxNodes */
/* */
/* PRQ628 mn@20111024 Markus Niederhauser */
/* crm4rmicMaxNodes -> RM68 + RM50 */
/*-------------------------------------------------------------------*/
/* Z1109090 PRQ381 A393014 CA90+CA93:Maske */
/* */
/* PRQ381 mn@20110719 Markus Niederhauser */
/* CA90+CA93:Maske forApplUse_01 */
/*-------------------------------------------------------------------*/
/*--------------+--------+-------------------------------------------*/
/* CcYy-mm-dd ¦ OFR ¦ Name, Instradation */
/* NME@CcYyMmDd ¦ xxx.0 ¦ - Correction A */
/* NM@CcYyMmDd ¦ yyy.0 ¦ - Correction B */
/*--------------+--------+-------------------------------------------*/
/* 2010-08-13 ¦ ¦ Niederhauser Markus, KCAB 323 */
/* mn@20100510 ¦ 479.x ¦ - add the fields */
/* ¦ ¦ - currentDate */
/* ¦ ¦ - dayOfWeek */
/*--------------+--------+-------------------------------------------*/
/* 2010-05-14 ¦ ¦ Niederhauser Markus, KCAB 323 */
/* mn@20100310 ¦ 479.x ¦ - CI70 */
/* mn@20100302 ¦ 479.x ¦ - CD71 */
/* mn@20100107 ¦ 479.x ¦ - CI76 */
/* mn@20100107 ¦ 479.x ¦ - CD87 */
/*--------------+--------+-------------------------------------------*/
/* 2010-02-12 ¦ ¦ Niederhauser Markus, KCAB 323 */
/* mn@20100105 ¦ 479.x ¦ - CI88 */
/* mn@20091218 ¦ 479.x ¦ - RM98: Mail=Y */
/* mn@20091216 ¦ 479.x ¦ - RM84 */
/* mn@20091208 ¦ 479.x ¦ - CI90 + CI91 */
/* mn@20091111 ¦ 479.x ¦ - YDA0720 */
/* ¦ 479.x ¦ - CA51 + CA52 + CA53 + CA54 */
/*--------------+--------+-------------------------------------------*/
/* 2009-11-13 ¦ ¦ Niederhauser Markus, KCAB 323 */
/* mn@20090824 ¦ 479.x ¦ - YCD083A, C & D */
/*--------------+--------+-------------------------------------------*/
/* 2009-08-14 ¦ ¦ Niederhauser Markus, KCAB 323 */
/* mn@20090603 ¦ 479.x ¦ - YCD083B */
/*--------------+--------+-------------------------------------------*/
/* 2009-02-13 ¦ ¦ Shanthi Chinnadurai, KCAB 323 */
/* cs@20081106 ¦ 312.5 ¦ - RM0980R trace option */
/* mn@20081110 ¦ 312.5 ¦ - YCD080B */
/*--------------+--------+-------------------------------------------*/
/* 2008-05-09 ¦ ¦ Markus Niederhauser, KSFI 411 */
/* mn@20080310 ¦ 191.6 ¦ - Eliminate EPLI-Warnings */
/*--------------+--------+-------------------------------------------*/
/* 2007-11-09 ¦ ¦ Markus Niederhauser, KSFI 411 */
/* mn@20070705 ¦ 988.0 ¦ - explementation of @compvers */
/* gl20070813 ¦ 988.0 ¦ - Compvers included */
/* mn@20070913 ¦ 988.0 ¦ - explementation of ceetdli */
/*--------------+----------------------------------------------------*/
/* 2007-08-10 ¦ Markus Niederhauser, KSFA 521 */
/* mn@20070424 ¦ - TCD900A1 -> TCD153A1 */
/*--------------+----------------------------------------------------*/
/* 2007-05-11 ¦ Markus Niederhauser, KSFA 521 */
/* mn@20070323 ¦ - YRM065B-Process */
/*--------------+----------------------------------------------------*/
/* 2007-03-09 ¦ Markus Niederhauser, KSFA 521 */
/* mn@20061031 ¦ - TCD150 -> TCD900 */
/*--------------+----------------------------------------------------*/
/* 2006-03-10 ¦ Markus Niederhauser, KBIE 21 */
/* mn@20051221 ¦ - Init anpassen für _C__77_ */
/*--------------+----------------------------------------------------*/
/* */
/* 11.11.2005 Markus Niederhauser / KBIE 21 /* Start mn20050830 */
/* - CDADMIN erweitern mit Release-Nummer */
/* */
/* 12.08.2005 Markus Niederhauser / KBIE 21 /* Start tm 050406 */
/* - Region-Name in TCD150 einfügen */
/* */
/* 17.09.2004 Markus Niederhauser KASK 21 /* Start mn 040826 */
/* - Plausis überarbeiten */
/* - PID='NOSECUR ' zulassen */
/* */
/* 04.02.2002 Markus Niederhauser KASK 21 /* mn 040202 */
/* Erweiterung mit Array von PIDs */
/* */
/* */
/*********************************************************************/
/*********************************************************************/
/** **/
/*********************************************************************/
/** **/
/** A. Zusammenhang **/
/** =============== **/
/** Es gibt die Tabelle TCD150. Auf dieser Tabelle kann von Hand **/
/** spezifiziert werden, ob eine gewisse Transaktion in die **/
/** Region putten soll oder nicht. **/
/** **/
/** **/
/** **/
/** B. Zweck **/
/** ======== **/
/** - Das aufrufende Programm übergibt dem yCDPUT3 den Programm- **/
/** Namen (CD150001) und die Version (CD150003). **/
/** - yCDPUT3 sucht die vorhandene Row, die den Schlüssel-feldern **/
/** CD150001 bis CD150004 entspricht. **/
/** - Gibt es keine passende Row, wird eine Row in die Tabelle **/
/** TCD150 eingefügt mit traceLevel=0 und keine PIDs. **/
/** - Die gefundene/eingefügte Row wird an das aufrufende **/
/** Programm zurückgegeben. Und zwar den Trace-Level (CD150011), **/
/** alle PIDs (CD150012) plus die Bit-Batterie von Put-Flags **/
/** **/
/** **/
/** **/
/** **/
/** C. Inhaltsverzeichnis **/
/** ===================== **/
/** **/
/** 1.0 D e k l a r a t i o n e n **/
/** 1.1 Kommunikationsstruktur **/
/** 1.2 Files **/
/** 1.3 Datuemer **/
/** 1.4 DB2 Applikatorisch **/
/** 1.5 DB2 Infra **/
/** 1.6 Strukturen **/
/** 1.7 Uebrige Deklarationen **/
/** **/
/** 2.0 O n - U n i t s **/
/** **/
/** 3.0 I n i t i a l i s i e r u n g e n **/
/** 3.1 Datuemer **/
/** 3.2 Outputparameter **/
/** **/
/** 4.0 M a i n - L o g i c **/
/** **/
/** 5.0 P r o z e d u r e n **/
/** 5.1 plausi_input_fields_ok **/
/** 5.3 PutProc **/
/** **/
/** **/
/*********************************************************************/
1/**-----------------------------------------------------------------**/
/** **/
/** 1.0 D e k l a r a t i o n e n **/
/** **/
/**-----------------------------------------------------------------**/
DCL TCD152KEYS CHAR(13000) INIT( (
'CA0420 CA0420 '||
'CA0440 CA0440 '||
'CA0510 CA0510 '||
'CA0530 CA0530 '||
'CB1300 CIFRelations_1_0 '||
'CB1300 CIFRelations_1_1 '||
'CB1300 CIFRelations_1_2 '||
'CB1310 CIFRelations_1_0 '||
'CB1310 CIFRelations_1_1 '||
'CD0790 CD0790 '||
'CI0020 CI0020 '||
'CI0050 IMS-online '||
'CI0060 IMS-online '||
'CI0210 CI0210 '||
'CI0220 CI0220 '||
'CI0230 CI0230 '||
'CI0310 CI0310 '||
'CI0320 CI0320 '||
'CI0880 CI0880 '||
'CUS_0004 CIFS_CustomerClone_1_0 '||
'CUS_0004 CIFS_CustomerClone_1_1 '||
'CUS_0008 CIFS_ServicingHistory_1_0 '||
'CUS_0010 CIFS_Customer_1_0 '||
'CUS_0010 CIFS_Customer_1_1 '||
'CUS_0013 CIFS_Customer_1_1 '||
'CUS_0014 CIFS_GetDetailForCifs_1_0 '||
'CUS_0015 CIFS_GetDetailForCifs_1_0 '||
'CUS_0024 CIFS_EntireClient_1_0 '||
'CUS_0025 PARS_SearchPartner_1_0 '||
'CUS_0030 CIFS_CCSegmentation_1_0 '||
'CUS_0031 CIFS_CCSegmentation_Update_1_0 '||
'CUS_0032 CIFS_CCSegmentation_Update_1_0 '||
'CUS_0035 CIFS_CifHistory_1_0 '||
'CUS_0036 CIFS_CifSearch_1_0 '||
'CUS_0036 CIFS_CifSearch_1_1 '||
'CUS_0037 CIFS_CifSearch_1_0 '||
'CUS_0037 CIFS_CifSearch_1_1 '||
'CUS_0038 CIFS_CifSearch_1_0 '||
'CUS_0038 CIFS_CifSearch_1_1 '||
'CUS_0039 CIFS_CifSearch_1_1 '||
'CUS_1082 CIFS_CifCreate_3_0 '||
'CUS_1116 CIFS_CifsByFHolders_3_0 '||
'CUS_1235 CIFRelations_1_1 '||
'CUS_1235 CIFRelations_1_2 '||
'CUS_1245 CIFRelations_1_1 '||
'CUS_1245 CIFRelations_1_2 '||
'CUS_1415 CIFS_CifUpdate_2_0 '||
'CUS_1416 CIFS_CifUpdate_2_0 '||
'CUS_1417 CIFS_CifUpdate_2_0 '||
'CUS_1418 CIFS_CifUpdate_2_0 '||
'CUS_1444 CIFS_Servicing_Update_3_0 '||
'CUS_1445 CIFS_Servicing_Update_3_0 '||
'CUS_1446 CIFS_Servicing_Update_3_0 '||
'CUS_1447 CIFS_Servicing_Update_3_0 '||
'CUS_1527 PARS_Partner_update_7_0 '||
'CUS_1528 PARS_Partner_7_0 '||
'CUS_1529 PARS_Partner_update_7_0 '||
'CUS_1530 PARS_Partner_update_7_0 '||
'CUS_1574 PARS_Relship_6_0 '||
'CUS_1579 PARS_Relship_6_0 '||
'CUS_1584 PARS_Relship_6_0 '||
'CUS_1720 CIFS_LTInstructUpdate_1_0 '||
'CUS_1721 CIFS_LTInstructUpdate_1_0 '||
'CUS_1722 CIFS_LTInstructUpdate_1_0 '||
'CUS_1723 CIFS_LTInstructUpdate_1_0 '||
'CU5900 CU5900 '||
'CU5930 CU5930 '||
'IF001125 CUPA_BK_SearchCifsByFHolders_3_0 '||
'IF001137 PINS_AG_DeleteKuhat_2_0 '||
'IF001138 CUPA_BN_CreateKuhat_2_0 '||
'IF001139 CUPA_BN_GetKuhat_2_0 '||
'IF001490 CIFS_CifParticipant_Update_1_0 '||
'IF001490 CUS/PIIN/CUS_CifParticipant '||
'IF001490 PIIN_BG_deleteCifPart_3_0 '||
'IF001491 CIFS_CifParticipant_Update_1_0 '||
'IF001491 CUS/PIIN/CUS_CifParticipant '||
'IF001491 PIIN_BG_createCifPart_3_0 '||
'IF001492 CIFS_CifParticipant_Update_1_0 '||
'IF001492 CUS/PIIN/CUS_CifParticipant '||
'IF001492 PIIN_BG_UpdateCifPart_3_0 '||
'IF001493 CIFS_CifParticipant_Update_1_0 '||
'IF001493 CUS/PIIN/CUS_CifParticipant '||
'IF001493 PIIN_BG_GetCifPartByCifPartIdTec_3_0 '||
'IF001494 CIFS_CifParticipant_Update_1_0 '||
'IF001494 CUPA_BJ_GetCifPartAddress_1_0 0 '||
'IF001494 CUS/PIIN/CUS_CifParticipant '||
'IF001494 PIIN_BG_GetCifPartsByCifNo_3_0 '||
'IF001494 PIIN_BG_GetCifPartsByCifNo_4_0 '||
'IF001618 getPartnersWithGranitExt_1.0 '||
'IF001636 CIFS_DepositsForCifs_1_0 '||
'IF001748 CIFS_Associations_Update_1_0 '||
'IF001748 CUPA_AC_GetUpCifBusAssoc_2_0 '||
'IF001749 CIFS_Associations_Update_1_0 '||
'IF001750 CIFS_Associations_Update_1_0 '||
'IF001751 CIFS_Associations_Update_1_0 '||
'IF001753 CIFS_Associations_Update_1_0 '||
'IF001756 CIFS_Associations_Update_1_0 '||
'IF001757 CIFS_Associations_Update_1_0 '||
'IF001758 CIFS_Associations_Update_1_0 '||
'IF001764 CUPA_BL_GetCifCareFuncAssignments_2_0 '||
'IF001814 CIFS_ElectronicAddr_Update_1_1 '||
'IF001814 CUPA_BN_GetElectronicAddress_2_0 '||
'IF001815 CIFS_ElectronicAddr_Update_1_1 '||
'IF001815 CUPA_BN_DeleteElectronicAddress_2_0 '||
'IF001816 CIFS_ElectronicAddr_Update_1_0 '||
'IF001816 CIFS_ElectronicAddr_Update_1_1 '||
'IF001817 CIFS_ElectronicAddr_Update_1_0 '||
'IF001817 CIFS_ElectronicAddr_Update_1_1 '||
'IF001817 CUPA_BN_CreateElectronicAddress_2_0 '||
'IF001818 CIFS_ElectronicAddr_Update_1_0 '||
'IF001818 CIFS_ElectronicAddr_Update_1_1 '||
'IF001818 CUPA_BN_UpdateElectronicAddress_2_0 '||
'IF001923 CIFS_CifCif_Update_1_0 '||
'IF001925 CIFS_CifCif_Update_1_0 '||
'IF001926 CIFS_CifCif_Update_1_0 '||
'IF001926 PARL_AA_GetUpCifCifsForCifs_2 '||
'IF001929 CUPA_BK_SearchCif_2_0 '||
'IF002105 PIIN_BB_UpdateAmlHeader_2_0 '||
'IF002106 PIIN_BB_GetAmlHeaders_2_0 '||
'IF002106 PIIN_BB_GetAmlHeaders_3_0 '||
'IF002141 CUPA_BI_GetCifsLong_3_0 '||
'IF002141 CUPA_BI_GetCifsLong_4_0 '||
'IF002552 CIFS_GetCifNoWithAnyNo_1_0 '||
'IF002634 CIFS_GwVIndividualLimits_2_0 '||
'IF002635 CIFS_GwVIndividualLimits_2_0 '||
'IF002636 CIFS_GwVIndividualLimits_2_0 '||
'IF002637 CIFS_GwVIndividualLimits_2_0 '||
'IF003412 INST_AddrInstructionUpdate_1_0 '||
'IF003412 PINS_AD_GetAddrInstructions_2 '||
'IF003413 INST_AddrInstructionUpdate_1_0 '||
'IF123491 CUPA_BD_GetAgreementsOfCifs_2_0 '||
'IF123491 CUS/CUPA/CUS_Agreement '||
'IF123493 CUPA_BE_getProprietorsWithTaxProps_5_0 '||
'IF123493 CUPA_BE_getProprietorsWithTaxProps_6_0 '||
'IF123493 CUPA_BE_getProprietorsWithTaxProps_7_0 '||
'IF123493 CUPA_BE_GetProprietorsWithTaxProps_1_0 '||
'IF123493 CUPA_BE_GetProprietorsWithTaxProps_2_0 '||
'IF123493 CUPA_BE_GetProprietorsWithTaxProps_3_0 '||
'IF123493 CUPA_BE_GetProprietorsWithTaxProps_4_0 '||
'IF123499 CUS/CUPA/CUS_Address_Registered '||
'IF123500 CUS/CUPA/CUS_Address_Registered '||
'IF123501 CUS/CUPA/CUS_Address_Registered '||
'IF123502 CUS/CUPA/CUS_Address_Registered '||
'IF123555 PARL_AO_GetRelations_1_0 '||
'IF123578 PARL_AN_DeletePartner_1_0 '||
'IF123579 PARL_AN_CreatePartner_1_0 '||
'IF123594 PARL_AN_UpdatePartner_1_0 '||
'IF123595 PARL_AN_GetPartner_1_0 '||
'IF123615 CUPA_BE_UpdateTaxPropsOfProprietors_4_0 '||
'IF123615 CUPA_BE_UpdTaxPropsOfProprietors_1_0 '||
'IF123615 CUPA_BE_UpdTaxPropsOfProprietors_2_0 '||
'IF123615 CUPA_BN_UpdateTaxPropsOfProprietors_5_0 '||
'IF123615 CUPA_BN_UpdateTaxPropsOfProprietors_6_0 '||
'IF123615 CUPA_BN_UpdateTaxPropsOfProprietors_7_0 '||
'IF123739 CUPA_BG_creCifInvSuitabilityResult_1_0 '||
'IF123740 CUPA_BG_GetCifInvSuitabilityResult_1_0 '||
'IF123741 CUPA_BG_UpdCifInvSuitabilityResult_1_0 '||
'IF123761 PARL_AP_CreatePartnerAgreementRel_1_0 '||
'IF123763 PARL_AP_DeletePartnerAgreementRel_1_0 '||
'IF123767 PARL_AP_GetPartnerAgreementRel_1_0 '||
'IF123858 CUPA_BH_CreateCifBUChangeRequest_1_0 '||
'IF123860 CUPA_BH_DeleteCifBUChangeRequest_1_0 '||
'IF123862 CUPA_BH_GetCifBUChangeRequest_1_0 '||
'IF124117 CUPA_BI_GetCifsBaseData_1_0 '||
'IF124212 CUPA_BJ_CreateCifPartAddress_1_0 '||
'IF124214 CUPA_BJ_UpdateCifPartAddress_1_0 '||
'IF124235 CUPA_BJ_DeleteCifPartAddress_1_0 '||
'IF124274 PIIN_BG_CreateCifPartIdentifying_1_0 '||
'IF124275 CUPA_BJ_GetCifPartIdentifying_1_0 '||
'IF124276 CUPA_BJ_GetCifPartIdentifying_1_0 '||
'IF124393 CUPA_BE_GetTaxRelevanceProfile_1_0 '||
'IF124393 CUPA_BE_GetTaxRelevanceProfile_2_0 '||
'IF124406 CUPA_BE_UpdateProprietorsAssetRatios_1_0 '||
'IF124410 CUPA_BE_CreateTaxPropsOfProprietors_3_0 '||
'IF124410 CUPA_BE_CreateTaxPropsOfProprietors_4_0 '||
'IF124410 CUPA_BE_CreateTaxPropsOfProprietors_5_0 '||
'IF124410 CUPA_BE_CreTaxPropsOfProprietors_1_0 '||
'IF124410 CUPA_BE_CreTaxPropsOfProprietors_2_0 '||
'IF124556 CUPA_BM_GetAddresses_1_0 '||
'IF124557 CUPA_BM_CreateAddress_1_0 '||
'IF124558 PB_CUPA_BM_UpdateAddress_1_0 '||
'IF124559 PB_CUPA_BM_DeleteAddress_1_0 '||
'IF124852 PARL_AO_GetClientNetwork_1_0 '||
'IF124852 PARL_AO_GetClientNetwork_2_0 '||
'IF124853 PARL_AN_GetPartnerWithCifs_1_0 '||
'IF124853 PARL_AN_GetPartnerWithCifs_2_0 '||
'IF124855 PARL_AN_SearchPartnersByFHolder_1.0 '||
'IF125010 PIIN_BE_CreateCifExternalIdentifier_1_0 '||
'IF125024 PIIN_BE_GetCifExternalIdentifierC_1.0 '||
'IF125025 PIIN_BE_DeleteCifExternalIdentifier_1_0 '||
'IF125032 PIIN_BE_GetCifExternalIdentifier_1.0 '||
'IF125041 PIIN_BE_updateCifExternalIdentifier_1_0 '||
'SEC_1600 DEPS_Deposit_1_0 '||
'SEC_1601 DEPS_Deposit_1_0 '||
'SEC_1602 DEPS_Deposit_1_0 '||
'XR5080 XR5080 '||
'IF123595 PARL_AN_GetPartner_2_0 '||
'IF002552 CUPA_AR_GetCifNosWithAnyNo_2_0 '
));
DCL 1 tcd152KeyInfos,
3 tcd152KeysPtr pointer init((addr(tcd152Keys))) ,
3 tcd152KeysMax bin fixed(31) init(198) ,
3 tcd152KeysRep bin fixed(31) init(100000) ,
3 tcd152KeysStep bin fixed(31) init(37) ,
3 tcd152KeysJx bin fixed(31) init(1) ,
3 c152Found bin fixed(31) init(0) ,
3 c152SelInto bin fixed(31) init(0) ,
3 cPidClientNoFo bin fixed(31) init(0) ,
3 cPidClientFound bin fixed(31) init(0) ,
3 cPidClientErr bin fixed(31) init(0) ,
3 cPidClientOp bin fixed(31) init(0) ,
3 cPidClientF1 bin fixed(31) init(0) ,
3 cPidClientF2 bin fixed(31) init(0) ,
3 cPidClientCl bin fixed(31) init(0) ,
3 cPidClientInto bin fixed(31) init(0) ,
3 cCommit bin fixed(31) init(0) ,
3 noSql bit (1)aligned init('0'b),
3 noCommit bit (1)aligned init('1'b);
dcl tcd152KeysIx bin fixed(31) init(-1) ;
DCL 1 TCD152KEYSTR based(tcd152KeysPtr),
3 tcd152key (200) ,
5 SERVICEID char(21),
5 INTERFACENAME char(42);
dcl 1 ttGpcif ,
3 i ,
5 userPid char( 8) ,
5 clientId char(10) ,
5 padd_01 char( 2) ,
3 o ,
5 hasFound bit(1)aligned ,
5 padd_01 char( 3) ,
5 traceLevel bin fixed(31) ,
5 getRegionName char( 1) ,
5 padd_02 char( 3) ,
3 endOfStruc char( 0) ;
-/**-----------------------------------------------------------------**/
/** 1.01 Kommunikationsstruktur **/
/**-----------------------------------------------------------------**/
dcl $PyCDPUT3 ptr;
dcl 1 yCDPUT3SP char(1000) init('');
dcl PyCDPUT3 ptr init(addr(yCDPUT3SP));
dcl 1 yCDPUT3k based(pycdput3),
%include yCDPUT3K ;;
-/**-----------------------------------------------------------------**/
/** 1.02 Files **/
/**-----------------------------------------------------------------**/
dcl Sysprint file print output ;
-/**-----------------------------------------------------------------**/
/** 1.03 Datuemer **/
/**-----------------------------------------------------------------**/
%include YcdTS;
dcl TimeStamp char(26) init ('');
-/**-----------------------------------------------------------------**/
/** 1.03 IMS **/
/**-----------------------------------------------------------------**/
/*
dcl 1 tp based ( CDPUT3_ptrLtm ) ,
%include TPPCBW ; ;
*/
dcl c2 bin fixed(31) static init(2);
dcl c3 bin fixed(31) static init(3);
dcl isrt char(04) static init('ISRT');
dcl chng char(04) static init('CHNG');
dcl purg char(04) static init('PURG');
dcl ii bin fixed(31);
dcl len bin fixed(31); /* Länge */
/*
dcl totl bin fixed(31); /* Total Länge / Rest Länge*/
/*
dcl anzm bin fixed(31); /* Anzahl Messages */
dcl dtoutl bin fixed(31); /* Daten-Output-Länge */
dcl poutmsg ptr; /* Ptr für Outmsg */
dcl ltm ptr;
dcl pgm ptr;
%include nsotppcb;
dcl 1 outmsg ,
%include nsoppm;
2 isPutOn bit (1)aligned init('0'b), /* mn@20100204 */
2 processType char(1) ,
2 padd_01 char(2) ,
2 dtout char(5900) ; /* Daten-Output thb241003*/
poutmsg = addr(outmsg);
-/**-----------------------------------------------------------------**/
/** 1.2 Program-specific MDL049 2008-03-19 **/
/**-----------------------------------------------------------------**/
%DCL COMPILETIME BUILTIN;
%DCL COMP_TIME CHAR;
%COMP_TIME = '''compilation-time: ' || COMPILETIME || '''';
%DCL COMP_VERS CHAR;
%comp_VERS = '''EPLI-compiler : EPLI' || '''' ;
-/**-----------------------------------------------------------------**/
/** 1.05 DB2 TCD150 **/
/**-----------------------------------------------------------------**/
/* Table */
exec SQL
declare TCD150A1 table
%include TCD150D;;
dcl 1 TCD150,
%include TCD150;;
/* Cursor */
exec SQL
declare C_yCDPUT3 cursor for
select %include TCD150F;
from TCD150A1
where CD150001 = :CDPUT3_metaId
and CD150002 = 'YCD'
and CD150003 = 'PUT'
and CD150005 < :TimeStamp
and CD150006 >= :TimeStamp
order by CD150003 ;
/* Cursor */
exec SQL
declare C_region cursor for
select %include TCD150F;
from TCD150A1
where CD150001 = :CDPUT3_metaId
and CD150002 = 'REG'
and CD150003 = 'ION'
and CD150005 < :TimeStamp
and CD150006 >= :TimeStamp
order by CD150003 ;
/* Cursor */
exec SQL
declare C_tracePidClientId cursor for
select %include TCD150F;
from TCD150A1
where CD150001 = 'TRACE'
and
( ( CD150002 = 'CLIE'
and CD150003 = 'NTID'
)
or
(
CD150002 = 'PID '
and CD150003 = ' '
)
)
and CD150005 < :TimeStamp
and CD150006 >= :TimeStamp
;
-/**-----------------------------------------------------------------**/
/** 1.05 DB2 TCD152 **/
/**-----------------------------------------------------------------**/
/* Table */
exec SQL
declare TCD152A1 table
%include TCD152D;;
dcl 1 TCD152 ,
%include TCD152; ,
2 currentTs char(26) ,
2 dayOfWeek bin fixed(31) ;
/* Cursor */
exec SQL
declare C_tcd152 cursor for
select %include TCD152F;
, current timestamp
, dayOfWeek( current date )
from TCD152A1
where serviceId = :CDPUT3_serviceId
and interfaceName = :CDPUT3_interfaceName
;
-/**-----------------------------------------------------------------**/
/** 1.06 DB2 tcd153 **/
/**-----------------------------------------------------------------**/
/* Table */
exec SQL
declare tcd153A1 table
%include tcd153D;;
dcl tcd153_area char(1000) init('') ;
dcl 1 tcd153 based
( addr(tcd153_area) ) ,
%include tcd153; ;
-/**-----------------------------------------------------------------**/
/** 1.06 DB2 tcd900 **/
/**-----------------------------------------------------------------**/
/* Table */
exec SQL
declare tcd900A1 table
%include tcd900D;;
dcl tcd900_area char(1000) init('') ;
dcl 1 tcd900 based
( addr(tcd900_area) ) ,
%include tcd900; ;
1/**-----------------------------------------------------------------**/
/** 1.5 ceetdli **/
/**-----------------------------------------------------------------**/
/*
%include ceeibmaw ;
*/
/*
dcl ceetdli entry; mn@20070913
*/
1/**-----------------------------------------------------------------**/
/** 1.5 CDADMIN **/
/**-----------------------------------------------------------------**/
dcl 1 cdadmin based( CDPUT3_ptrCdadmin ) ,
%include cdadmins; ;
1/**-----------------------------------------------------------------**/
/** 1.5 DB2 Infrastruktur **/
/**-----------------------------------------------------------------**/
exec sql include SQLCA ;
-/**-----------------------------------------------------------------**/
/** 1.6 Strukturen **/
/**-----------------------------------------------------------------**/
dcl
1 aux , /* auxiliary */
3 isPutOn bit(1) aligned init('0'b) ,
3 putFlag(100) char(1) init((100)('')),
3 C_tcd152_open bit(1) aligned init('0'b) ,
3 C_yCDPUT3_open bit(1) aligned init('0'b) ,
3 c_region_open bit(1) aligned init('0'b) ,
3 c_tracePidClientId_open bit(1) aligned init('0'b) ,
3 ts char(26) init( '' ),
3 t bin fixed(31,0) init( 0 ) , /* tabulator */
3 p_9 pic'9' init( 0 ) ;
-/**-----------------------------------------------------------------**/
/** 1.7 Uebrige Deklarationen **/
/**-----------------------------------------------------------------**/
dcl ( addr
, cstg
, datetime
, hbound
, high
, length
, max
, min
, mod
, null
, ptradd
, string
, substr
, sysnull
, translate
, verify ) builtin;
1/**-----------------------------------------------------------------**/
/** **/
/** 2.0 O n - U n i t s **/
/** **/
/**-----------------------------------------------------------------**/
1/**-----------------------------------------------------------------**/
/** **/
/** 3.0 I n i t i a l i s i e r u n g e n **/
/** **/
/**-----------------------------------------------------------------**/
-/**-----------------------------------------------------------------**/
/** 3.1 Datuemer **/
/**-----------------------------------------------------------------**/
TimeStamp = YcdTS('E');
1/**-----------------------------------------------------------------**/
/** **/
/** 5.0 P r o z e d u r e n **/
/** **/
/**-----------------------------------------------------------------**/
/**-----------------------------------------------------------------**/
/** 5.1 plausi_input_fields_ok **/
/**-----------------------------------------------------------------**/
plausi_input_fields_ok:
Proc
returns ( bit(1) aligned );
dcl @hasFehler bit(1) aligned init('0'b);
YCDM616
do; /* Diese Prüfung muss vor dem ersten Put passieren */ YCDM616
DCL CDPUT3_whichSysprint based(addr(CDPUT3_sysprint)) char(4) ; YCDM61
if (CDPUT3_whichSysprint = '') then YCDPUT
do;
aux.isPutOn = '1'b;
CDPUT3_sysprint = sysprint;
call putM('*' ,70);
call putR('** CDPUT3_sysprint nicht abgefüllt' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
end; /* Diese Prüfung muss vor dem ersten Put passieren */ YCDM616
if ( $PyCDPUT3 = null()) then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** $pyCDPUT3 ist null' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
if aux.isPutOn then
do;
call putFrame('start'
,'plausi_input_fields_ok' ,70);
call putR('** eye . . . . . : ' ||
CDPUT3_eye ,70);
call putR('** release . . . : ' ||
CDPUT3_release ,70);
call putR('** processType . : ' ||
in.CDPUT3_processType ,70);
call putR('** interfaceName : ' ||
in.CDPUT3_interfaceName ,70);
call putR('** operationName : ' ||
in.CDPUT3_operationName ,70);
call putR('** serviceId . . : ' ||
in.CDPUT3_serviceId ,70);
call putR('** pgmName . . . : ' ||
in.CDPUT3_pgmName ,70);
call putR('** metaId . . . : ' ||
in.CDPUT3_metaId ,70);
call putR('** bereich . . . : ' ||
in.CDPUT3_bereich ,70);
call putR('** pid . . . . . : ' ||
in.CDPUT3_pid ,70);
call putR('** mainPgmName . : ' ||
in.CDPUT3_mainPgmName ,70);
call putR('** traceLevel . : ' ||
bin31_to_char(in.CDPUT3_traceLevel) ,70);
/*
call putR('** comp . . . . : ' ||
in.CDPUT3_comp ,70);
*/
end;
if (CDPUT3_eye ^= '#@YCDPUT3@#') then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDPUT3_eye ist nicht korrekt' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putR('** Eye : ' || CDPUT3_eye ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
if ( CDPUT3_release = 'Rel.0004' ) then
do;
end;
else
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDPUT3_release ist falsch' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putR('** Release : ' || CDPUT3_release ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
/*
if (in.CDPUT3_processType = '1') then /* Top-Module */
/*
do;
*/
if (in.CDPUT3_ptrCdadmin = null()) then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDPUT3_ptrCdadmin ist null' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
else
do;
if (cdadmin_01 ^= '#@CDADMIN@#') then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDADMIN_01 ist nicht korrekt' ,70);
call putR('** CDADMIN_01 : ' || CDADMIN_01 ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
if (cdadmin_01a ^= 'Rel.0001') then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDADMIN_01a ist falsch' ,70);
call putR('** CDADMIN_01a : ' || cdadmin_01a ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
end;
/*
end;
*/
if (CDPUT3_SQLCA = null()) then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDPUT3_sqlca ist null' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
if (in.CDPUT3_processType = '1') then /* Top-Module */
do;
if (CDPUT3_metaId = '') then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDPUT3_metaId ist blank' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
end;
if (in.CDPUT3_processType = '1') then /* Top-Module */
do;
if (in.CDPUT3_pid = '' |
in.CDPUT3_pid = 'specify') then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDPUT3_pid muss abgefüllt werden' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
end;
if (CDPUT3_mainPgmName = '' |
CDPUT3_mainPgmName = 'specify') then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDPUT3_mainPgmName muss abgefüllt werden' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
if (in.CDPUT3_processType = '1') then /* Top-Module */
do;
if ( in.CDPUT3_pid ^= 'nosecur '
& in.CDPUT3_pid ^= 'NOSECUR '
& in.CDPUT3_pid ^= 'specify '
& in.CDPUT3_pid ^= '' ) then
do;
if ((verify(substr(in.CDPUT3_pid ,1,1),
'ABCDEFGHIJKLMNOPQRSTUVWXYZ') ^= 0 |
verify(substr(in.CDPUT3_pid,2,7),'0123456789 ') ^= 0)) then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** Service . : '|| CDPUT3_metaId ,70);
call putR('** CDPUT3_pid : '||in.CDPUT3_pid ,70);
call putR('** CDPUT3_pid ist ungueltig' ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
end;
end;
if aux.isPutOn then
do;
call putFrame('end ','plausi_input_fields_ok' ,70);
end;
/* Analse */
/* ------ */
if @hasFehler then
do;
CDPUT3_RC = 10;
return('0'b) ;
end;
else
do;
CDPUT3_RC = 0 ;
return('1'b) ;
end;
end plausi_input_fields_ok;
1/**-----------------------------------------------------------------**/
/** 5.22 Bin31_To_Char **/
/**-----------------------------------------------------------------**/
Bin31_To_Char: proc ( @bin31 )
returns ( char(5)var );
dcl @bin31 bin fixed(31) ;
dcl @charVar char(5) var init('') ;
select ;
when ( @bin31 < 10
& @bin31 > -10 )
do;
@charVar = bin31_to_char1( @bin31 );
end;
when ( @bin31 < 100
& @bin31 > -100 )
do;
@charVar = bin31_to_char2( @bin31 );
end;
when ( @bin31 < 1000
& @bin31 > -1000 )
do;
@charVar = bin31_to_char3( @bin31 );
end;
when ( @bin31 < 10000
& @bin31 > -10000 )
do;
@charVar = bin31_to_char4( @bin31 );
end;
otherwise
do;
@charVar = bin31_to_char5( @bin31 );
end;
end; /* select ( @bin31 ) */
if @bin31 < 0 then
do;
@charVar = '-' || @charVar ;
end;
return ( @charVar ) ;
end Bin31_To_Char ;
/*
Bin31_To_Char1 mdl MDL076
Bin31_To_Char2 mdl MDL004
Bin31_To_Char3 mdl MDL003
Bin31_To_Char4 mdl MDL005
Bin31_To_Char5 mdl MDL074
*/
1/**-----------------------------------------------------------------**/
/** 5.22 Bin31_To_Char1 **/
/**-----------------------------------------------------------------**/
Bin31_To_Char1: proc ( @bin31 )
returns ( char(1) );
dcl @bin31 bin fixed(31) ;
dcl @p9 pic'9' init( 0) ;
dcl @char1 based(addr(@p9)) char ( 1 );
@p9 = @bin31 ;
return ( @char1 ) ;
end Bin31_To_Char1 ;
1/**-----------------------------------------------------------------**/
/** 5.22 Bin31_To_Char2 **/
/**-----------------------------------------------------------------**/
Bin31_To_Char2: proc ( @bin31 )
returns ( char(2) );
dcl @bin31 bin fixed(31) ;
dcl @pz9 pic'z9' init( 0) ;
dcl @char2 based(addr(@pz9)) char ( 2 );
@pZ9 = @bin31 ;
return ( @char2 ) ;
end Bin31_To_Char2 ;
1/**-----------------------------------------------------------------**/
/** 5.21 Bin31_To_Char3 **/
/**-----------------------------------------------------------------**/
Bin31_To_Char3: proc ( @bin31 )
returns ( char(3) );
dcl @bin31 bin fixed(31) ;
dcl @pzz9 pic'zz9' init( 0) ;
dcl @char3 based(addr(@pzz9)) char ( 3 );
@pZZ9 = @bin31 ;
return ( @char3 ) ;
end Bin31_To_Char3 ;
1/**-----------------------------------------------------------------**/
/** 5.23 Bin31_To_Char4 **/
/**-----------------------------------------------------------------**/
Bin31_To_Char4: proc ( @bin31 )
returns ( char(4) );
dcl @bin31 bin fixed(31) ;
dcl @pzzz9 pic'---9' init( 0) ;
dcl @char4 based(addr(@pzzz9)) char ( 4 );
@pZZZ9 = @bin31 ;
return ( @char4 ) ;
end; /* Bin31_To_Char4 */
1/**-----------------------------------------------------------------**/
/** 5.23 Bin31_To_Char5 **/
/**-----------------------------------------------------------------**/
Bin31_To_Char5: proc ( @bin31 )
returns ( char(5) );
dcl @bin31 bin fixed(31) ;
dcl @pzzzz9 pic'zzzz9' init( 0) ;
dcl @char5 based(addr(@pzzzz9)) char ( 5 );
@pZZZZ9 = @bin31 ;
return ( @char5 ) ;
end Bin31_To_Char5 ;
1/**-----------------------------------------------------------------**/
/** 5.2 Fetch_C_tcd152_ok **/
/**-----------------------------------------------------------------**/
Fetch_C_tcd152_ok:
Proc ( $p_fcyo )
returns ( bit(1) aligned );
dcl $p_fcyo ptr ;
dcl 1 @fcyo based ($p_fcyo) ,
3 i ,
5 dummy char( 0) init('') ,
3 o ,
5 hasFound bit ( 1) aligned init('') ,
5 padd_01 char( 3) init('') ,
5 end char( 0) init('') ;
dcl @isOk bit(1)aligned init('1'b);
if aux.isPutOn then
do;
call putFrame('start','Fetch_C_tcd152_ok' ,70);
end;
/*
dcl 1 @tcd152 ,
%include tcd152 ;;
*/
/*****************/
/** Fetch Row **/
/*****************/
do;
if noSql then
sqlCode = 0;
else
exec SQL
fetch C_tcd152
into :TCD152 ;
select ( sqlca.sqlcode ) ;
when ( 0 )
do;
@fcyo.o.hasFound = '1'b;
end;
when ( 100 )
do;
@fcyo.o.hasFound = '0'b;
end;
otherwise
do;
aux.isPutOn = '1'b ;
@isOk = '0'b ;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'Fetch C_tcd152'
, '1010' /* traceId */
) then @isOk = '0'b ;
end;
end;
end;
if aux.isPutOn then
do;
call putR ('** @hasFound : ' ||
@fcyo.o.hasFound ,70);
call putR ('** @isOk . . : ' ||
@isOk ,70);
call putFrame('end ','Fetch_C_tcd152_ok' ,70);
end;
return( @isOk ) ;
end Fetch_C_tcd152_ok;
1/**-----------------------------------------------------------------**/
/** 5.2 Fetch_C_tracePidClientId_ok **/
/**-----------------------------------------------------------------**/
Fetch_C_tracePidClientId_ok:
Proc ( $p_ftpc )
returns ( bit(1) aligned );
dcl $p_ftpc ptr ;
dcl 1 @ftpc based ($p_ftpc) ,
3 i ,
5 userPid char( 8) ,
5 clientId char(10) ,
5 padd_01 char( 2) ,
3 o ,
5 hasFound bit ( 1) aligned ,
5 padd_01 char( 3) ,
5 uSwitch bin fixed(31) ,
/* 1 : userPid found */
/* 2 : clientId found */
5 userPid char( 8) ,
5 clientId char(10) ,
5 padd_02 char( 2) ,
3 endOfStruc char( 0) ;
dcl @isOk bit(1)aligned init('1'b);
if aux.isPutOn then
do;
call putFrame('start','Fetch_C_tracePidClientId_ok' ,70);
end;
@ftpc.o.hasFound = '0'b;
/*****************/
/** Fetch Row **/
/*****************/
exec SQL
fetch C_tracePidClientId
into :TCD150 ;
cPidClientF1 = cPidClientF1 + 1;
do while ( sqlca.sqlcode = 0
& ^@ftpc.o.hasFound
) ;
select ( sqlca.sqlcode ) ;
when ( 0 )
do;
select;
when ( @ftpc.i.userPid = substr(tcd150.cd150011,1,8) )
do;
@ftpc.o.hasFound = '1'b ;
@ftpc.o.uSwitch = 1 ;
@ftpc.o.userPid = substr(tcd150.cd150011,1,8) ;
aux.isPutOn = '1'b ;
call putR('** getRegionName is switched on by' ||
' userPid' ,70);
call putR('** on TCD150.' ,70);
end;
when ( @ftpc.i.clientId = substr(tcd150.cd150011,1,10) )
do;
@ftpc.o.hasFound = '1'b ;
@ftpc.o.uSwitch = 2 ;
@ftpc.o.clientId = substr(tcd150.cd150011,1,10) ;
aux.isPutOn = '1'b ;
call putR('** getRegionName is switched on by' ||
' clientId' ,70);
call putR('** on TCD150.' ,70);
end;
otherwise
do;
end;
end; /* select */
end;
when ( 100 )
do;
@ftpc.o.hasFound = '0'b;
end;
otherwise
do;
aux.isPutOn = '1'b ;
@isOk = '0'b ;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'Fetch C_tracePidClientId'
, '1010' /* traceId */
) then @isOk = '0'b ;
end;
end;
exec SQL
fetch C_tracePidClientId
into :TCD150 ;
cPidClientF2 = cPidClientF2 + 1;
end; /* do while (sqlca.sqlcode = 0) */
if aux.isPutOn then
do;
call putR ('** hasFound : ' ||
@ftpc.o.hasFound ,70);
call putR ('** uSwitch . : ' ||
bin31_to_char(@ftpc.o.uSwitch) ,70);
call putR ('** userPid . : ' ||
@ftpc.o.userPid ,70);
call putR ('** clientId : ' ||
@ftpc.o.clientId ,70);
call putR ('** @isOk . . : ' ||
@isOk ,70);
call putFrame('end ','Fetch_C_tracePidClientId_ok' ,70);
end;
return( @isOk ) ;
end Fetch_C_tracePidClientId_ok;
1/**-----------------------------------------------------------------**/
/** 5.2 Fetch_C_REGION_ok **/
/**-----------------------------------------------------------------**/
Fetch_C_REGION_ok:
Proc ( $p_fcro )
returns ( bit(1) aligned );
dcl $p_fcro ptr ;
dcl 1 @fcro based ($p_fcro) ,
3 i ,
5 dummy char( 0) ,
3 o ,
5 found bit ( 1) aligned ,
5 notFound bit ( 1) aligned ,
5 padd_01 char( 2) ,
5 end char( 0) ;
if aux.isPutOn then
do;
call putFrame('start'
,'Fetch_C_REGION_ok' ,70);
end;
/*****************/
/** Fetch Row **/
/*****************/
do;
exec SQL
fetch C_REGION
into %include TCD150V;;
select ( sqlca.sqlcode ) ;
when ( 0 )
do;
@fcro.o.found = '1'b;
end;
when ( 100 )
do;
@fcro.o.notFound = '1'b;
end;
otherwise
do;
aux.isPutOn = '1'b;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'Fetch C_REGION'
, '1010' /* traceId */
) then return('0'b);
end;
end;
end;
if aux.isPutOn then
do;
call putFrame('end '
,'Fetch_C_REGION_ok' ,70);
end;
return('1'b) ;
end Fetch_C_REGION_ok;
1/**-----------------------------------------------------------------**/
/** 5.26 putM **/
/**-----------------------------------------------------------------**/
putM: proc($str , $pos);
dcl $str char(*);
dcl $pos bin fixed(31);
dcl @pos bin fixed(31) init( 0) ;
dcl @i bin fixed(31) init( 0) ;
dcl @line char(200) var init('') ;
dcl 1 @l , /* length */
3 asa bin fixed(31) init( 1) ,
3 pgmName bin fixed(31) init( 8) ,
3 corr bin fixed(31) init( 1) , /* Korrektur */
3 str bin fixed(31) init( 0) ;
dcl 1 @p , /* position */
3 t1 bin fixed(31) init( 66) , /* Tabulator 1 */
3 t2 bin fixed(31) init( 96) , /* Tabulator 2 */
3 t3 bin fixed(31) init(115) ; /* Tabulator 3 */
/* PutProc mit Wiederholbarem Input */
if ( aux.isPutOn ) then
do;
@pos = $pos ;
do; /* Repeated Character */
do @i = @l.asa+@l.pgmName+1+@l.pgmName+1+@l.corr to @pos ;
@line = @line || $str ;
end; /* next */
@line = @line || ' ' ;
end; /* Repeated Character */
do; /* Füllen bis Tab1 */
do @i = @pos+@l.corr to @p.t1 ;
@line = @line || ' ' ;
end; /* next */
end; /* Füllen bis Datum */
@pos = max(@pos , @p.t1) ;
do; /* Zeit & Datum */
if ( @pos-@l.corr < @p.t2 ) then
do;
@line = @line || translate('ij:kl:mn:opq abcd-ef-gh'
, datetime()
,'abcdefghijklmnopq'
);
end;
end; /* Zeit & Datum */
put file(CDPUT3_Sysprint) edit( CDPUT3_mainPgmName || ' ' ||
'YCDPUT3 ' ||
@line )(skip,a);
end;
end; /* putM */
1/**-----------------------------------------------------------------**/
/** 5.26 putR **/
/**-----------------------------------------------------------------**/
putR: proc($str , $pos);
dcl $str char(*);
dcl $pos bin fixed(31);
dcl @pos bin fixed(31) init( 0) ;
dcl 1 @l , /* length */
3 asa bin fixed(31) init( 1) ,
3 pgmName bin fixed(31) init( 8) ,
3 corr bin fixed(31) init( 1) , /* Korrektur */
3 str bin fixed(31) init( 0) ;
dcl 1 @p , /* position */
3 t1 bin fixed(31) init( 66) , /* Tabulator 1 */
3 t2 bin fixed(31) init( 96) , /* Tabulator 2 */
3 t3 bin fixed(31) init(115) ; /* Tabulator 3 */
dcl @i bin fixed(31) init( 0) ;
dcl @line char(200) var init( '') ;
/* PutProc mit Rahmen */
/* Dieses Procedure schreibt nur, wenn der Puts-Flag */
/* auf "on" gesetzt ist. */
if ( aux.isPutOn ) then
do;
@pos = $pos ;
do; /* Vorbereitung */
@l.str = length($str) ;
do @i = @l.str to 1 by -1
while (substr($str, @i, 1) = '') ;
end;
@l.str = @i ;
end; /* Vorbereitung */
do; /* @str */
@line = substr( $str, 1, @l.str ) ;
end; /* @str */
@pos = max(@pos , @l.str+@l.asa+2*@l.pgmName+2+4) ;
do; /* Rahmen-Abschluss */
do @i = @l.asa+@l.pgmName+1
+@l.pgmName+1+@l.str to @pos-@l.corr-4 ;
@line = @line || ' ' ;
end; /* next */
if ( @pos-@l.corr < @p.t3 ) then
@line = @line || ' ** ' ;
end; /* Rahmen-Abschluss */
do; /* Füllen bis Tab1 */
do @i = @pos+@l.corr to @p.t1 ;
@line = @line || ' ' ;
end; /* next */
end; /* Füllen bis Tab1 */
do; /* Zeit & Datum */
if ( @pos-@l.corr < @p.t2 ) then
do;
@line = @line || translate('ij:kl:mn:opq abcd-ef-gh'
, datetime()
,'abcdefghijklmnopq'
);
end;
end; /* Zeit & Datum */
put file(CDPUT3_Sysprint) edit( CDPUT3_mainPgmName || ' ' ||
'YCDPUT3 ' ||
@line )(skip,a);
end;
end; /* putR */
/**-----------------------------------------------------------------**/
/** 5.1 getDataFromTCD152_ok **/
/**-----------------------------------------------------------------**/
getDataFromTCD152_ok:
Proc(p)
returns ( bit(1) aligned );
dcl p pointer;
/**--------**/
/** open **/
/**--------**/
if ^open_C_tcd152_ok () then
do;
put ('open_C_tcd152_ok not ok') skip;
end;
else
do;
/**---------**/
/** fetch **/
/**---------**/
dcl 1 @fcyo ,
3 i ,
5 dummy char( 0) init( '' ) ,
3 o ,
5 hasFound bit ( 1) aligned init('0'b) ,
5 padd_01 char( 3) init( '' ) ,
5 end char( 0) init( '' ) ;
if ^Fetch_C_tcd152_ok ( addr(@fcyo) ) then
do;
put ('Fetch_C_tcd152_ok not ok') skip;
end;
else
do;
if ( @fcyo.o.hasFound ) then
do;
c152Found = c152Found + 1;
/* put ('Fetch_C_tcd152_ok has found') skip; */
end;
else
do;
put ('Fetch_C_tcd152_ok has notfound') skip;
end;
end; /* fetch */
end; /* open */
/**---------**/
/** close **/
/**---------**/
if ^close_C_tcd152_ok () then
do;
put ('close_C_tcd152_ok not ok') skip;
end;
return('1'b);
end getDataFromTCD152_ok ;
/**-----------------------------------------------------------------**/
/** 5.1 getPidClientIdFromTCD150_ok **/
/**-----------------------------------------------------------------**/
getPidClientIdFromTCD150_ok:
Proc ( $p_gpcif )
returns ( bit(1) aligned );
dcl $p_gpcif ptr ;
dcl 1 @gpcif based( $p_gpcif ) ,
3 i ,
5 userPid char( 8) ,
5 clientId char(10) ,
5 padd_01 char( 2) ,
3 o ,
5 hasFound bit(1)aligned ,
5 padd_01 char( 3) ,
5 traceLevel bin fixed(31) ,
5 getRegionName char( 1) ,
5 padd_02 char( 3) ,
3 endOfStruc char( 0) ;
dcl @isOk bit(1)aligned init('1'b);
if aux.isPutOn then
do;
call putFrame('start','getPidClientIdFromTCD150_ok' ,70);
end;
/**------------------------**/
/** Initializing Output **/
/**------------------------**/
do;
@gpcif.o.getRegionName = 'N' ;
@gpcif.o.hasFound = '0'b ;
end;
/**--------**/
/** open **/
/**--------**/
/* get all "Trace" */
if ^open_C_tracePidClientId_ok () then
do;
@isOk = '0'b;
end;
else
do;
/**---------**/
/** fetch **/
/**---------**/
dcl 1 @ftpc ,
3 i ,
5 userPid char( 8) init( '' ) ,
5 clientId char(10) init( '' ) ,
5 padd_01 char( 2) init( '' ) ,
3 o ,
5 hasFound bit ( 1) aligned init('0'b) ,
5 padd_01 char( 3) init( '' ) ,
5 uSwitch bin fixed(31) init( 0 ) ,
5 userPid char( 8) init( '' ) ,
5 clientId char(10) init( '' ) ,
5 padd_02 char( 2) init( '' ) ,
3 endOfStruc char( 0) init( '' ) ;
@ftpc.i.userPid = @gpcif.i.userPid ;
@ftpc.i.clientId = @gpcif.i.clientId ;
if ^Fetch_C_tracePidClientId_ok ( addr(@ftpc) ) then
do;
@isOk = '0'b;
end;
else
do;
@gpcif.o.hasFound = @ftpc.o.hasFound ;
if ( @gpcif.o.hasFound ) then
do;
aux.isPutOn = '1'b ;
@gpcif.o.traceLevel = 0 ;
@gpcif.o.getRegionName = 'Y' ;
end;
end; /* fetch */
end; /* open */
/**---------**/
/** close **/
/**---------**/
if ^close_C_tracePidClientId_ok () then
do;
@isOk = '0'b;
end;
if aux.isPutOn then
do;
call putR ('**' ,70);
call putR ('** hasFound . . . : ' ||
@gpcif.o.hasFound ,70);
call putR ('** traceLevel . . : ' ||
bin31_to_char(@gpcif.o.traceLevel) ,70);
call putR ('** getRegionName : ' ||
@gpcif.o.getRegionName ,70);
call putR ('** @isOk . . . . : ' ||
@isOk ,70);
call putFrame('end ','getPidClientIdFromTCD150_ok' ,70);
end;
return( @isOk ) ;
end /* getPidClientIdFromTCD150_ok */ ;
/**-----------------------------------------------------------------**/
/** 5.1 putTcd152_ok **/
/**-----------------------------------------------------------------**/
putTcd152_ok:
Proc
returns ( bit(1) aligned );
dcl @isOk bit(1)aligned init('1'b);
dcl @i bin fixed(31) init( 0 );
dcl @m bin fixed(31) init( 0 );
if aux.isPutOn then
do;
call putFrame ('start','putTcd152_ok' ,70);
call putR ('** Key' ,70);
call putR ('** serviceId . . . . : ' ||
tcd152.serviceId ,70);
call putR ('** Alternative Key' ,70);
call putR ('** operationName . . : ' ||
tcd152.operationName ,70);
call putR ('** interfaceName . . : ' ||
tcd152.interfaceName ,70);
call putR ('** pgmName . . . . . : ' ||
tcd152.pgmName ,70);
call putR ('** Trace-Level' ,70);
call putR ('** general' ,70);
call putR ('** traceLvlAll . . : ' ||
tcd152.traceLvlAll ,70);
call putR ('** getRegionAll . : ' ||
tcd152.getRegionAll ,70);
/**------------**/
/** pidStruc **/
/**------------**/
do;
call putR ('** pidStruc' ,70);
dcl
1 @pidStruc based( addr (tcd152.pid_01) ) ,
3 a(10) ,
5 pid char( 8) ,
5 clientId char(10) ,
5 traceLvl char( 1) ,
5 getRegion char( 1) ,
3 endOfStruc char( 0) ;
@m = hbound(@pidStruc.a,1) ;
do @i=1 to @m
while( @pidStruc.a(@i).pid ^= ''
| @pidStruc.a(@i).clientId ^= '' );
call putR ('** '||putIP(@i,@m) ,70);
call putR ('** pid . . . . . : ' ||
@pidStruc.a(@i).pid ,70);
call putR ('** clientId . . : ' ||
@pidStruc.a(@i).clientId ,70);
call putR ('** traceLvl . . : ' ||
@pidStruc.a(@i).traceLvl ,70);
call putR ('** getRegion . . : ' ||
@pidStruc.a(@i).getRegion ,70);
end; /* do @i=1 to @m */
if @i=1 then
do;
call putR ('** none available' ,70);
end;
end;
/**--------------**/
/** components **/
/**--------------**/
do;
call putR ('** components' ,70);
dcl
1 @components based( addr (tcd152.componentName_01) ) ,
3 a(10) ,
5 componentName char( 8) ,
5 componentTLvl char( 1) ,
3 endOfStruc char( 0) ;
@m = hbound(@components.a,1) ;
do @i=1 to @m
while( @components.a(@i).componentName ^= '' );
call putR ('** '||putIP(@i,@m) ,70);
call putR ('** componentName . : ' ||
@components.a(@i).componentName ,70);
call putR ('** componentTLvl . : ' ||
@components.a(@i).componentTLvl ,70);
end; /* do @i=1 to @m */
if @i=1 then
do;
call putR ('** none available' ,70);
end;
end;
/**--------------**/
/** clientIdA **/
/**--------------**/
do;
call putR ('** clientId allowed' ,70);
call putR ('** inOrExclude . . . : ' ||
tcd152.inOrExclude ,70);
dcl
1 @clientIdA based( addr (tcd152.clientIdA_01) ) ,
3 a(10) ,
5 clientIdA char(10) ,
3 endOfStruc char( 0) ;
@m = hbound(@components.a,1) ;
do @i=1 to @m
while( @clientIdA.a(@i).clientIdA ^= '' );
call putR ('** '||putIP(@i,@m) ,70);
call putR ('** clientIdA . . . : ' ||
@clientIdA.a(@i).clientIdA ,70);
end; /* do @i=1 to @m */
if @i=1 then
do;
call putR ('** none available' ,70);
end;
end;
/**--------------**/
/** forApplUse **/
/**--------------**/
do;
call putR ('** forApplUse' ,70);
dcl
1 @forApplUse based( addr (tcd152.forApplUse_01) ) ,
3 a( 3) ,
5 forApplUse char(200) ,
3 endOfStruc char( 0) ;
@m = hbound(@forApplUse.a,1) ;
do @i=1 to @m
while( @forApplUse.a(@i).forApplUse ^= '' );
call putR ('** '||putIP(@i,@m) ,70);
call putR ('** forApplUse . . : ' ||
@forApplUse.a(@i).forApplUse ,70);
end; /* do @i=1 to @m */
if @i=1 then
do;
call putR ('** none available' ,70);
end;
end;
/**--------------**/
/** date **/
/**--------------**/
do;
call putR ('** date' ,70);
call putR ('** currentTs . . . : ' ||
tcd152.currentTs ,70);
call putR ('** dayOfWeek . . . : ' ||
bin31_to_char(tcd152.dayOfWeek) ,70);
end;
call putFrame ('end ','putTcd152_ok' ,70);
end;
return( @isOk ) ;
end putTcd152_ok ;
/**-----------------------------------------------------------------**/
/** 5.01 fill_tcd153_struc_ok **/
/**-----------------------------------------------------------------**/
fill_tcd153_struc_ok:
Proc
returns ( bit(1) aligned );
dcl @isOk bit(1) aligned init('1'b);
if aux.isPutOn then
do;
call putFrame('start','fill_tcd153_struc_ok' ,70);
end;
tcd153.start_ts = CDPUT3_start_ts ;
tcd153.interfaceName = CDPUT3_interfaceName ;
tcd153.operationName = CDPUT3_operationName ;
tcd153.trx = CDPUT3_trxName ;
tcd153.pgmName = CDPUT3_pgmName ;
tcd153.clientId = CDPUT3_clientId ;
tcd153.pid = in.CDPUT3_pid ;
tcd153.traceLevel = bin31_to_char1(out.CDPUT3_traceLevel) ;
tcd153.duration_ts = getDifference( CDPUT3_start_ts
, CDPUT3_end_ts );
tcd153.serviceId = CDPUT3_serviceId ;
tcd153.forApplUse_01 = CDPUT3_153ForApplUse_01;
;
if aux.isPutOn then
do;
call putR ('** start_ts . . : ' ||
tcd153.start_ts ,70);
call putR ('** interfaceName : ' ||
tcd153.interfaceName ,70);
call putR ('** operationName : ' ||
tcd153.operationName ,70);
call putR ('** trx . . . . . : ' ||
tcd153.trx ,70);
call putR ('** pgmName . . . : ' ||
tcd153.pgmName ,70);
call putR ('** clientId . . : ' ||
tcd153.clientId ,70);
call putR ('** pid . . . . . : ' ||
tcd153.pid ,70);
call putR ('** traceLevel . : ' ||
tcd153.traceLevel ,70);
call putR ('** regionName . : ' ||
tcd153.regionName ,70);
call putR ('** jobNr . . . . : ' ||
tcd153.jobNr ,70);
call putR ('** duration_ts . : ' ||
tcd153.duration_ts ,70);
call putR ('** serviceId . . : ' ||
tcd153.serviceId ,70);
call putR ('** forApplUse_01 : ' ||
tcd153.forApplUse_01 ,70);
end;
if aux.isPutOn then
do;
call putFrame('end ','fill_tcd153_struc_ok' ,70);
end;
return( @isOk ) ;
end fill_tcd153_struc_ok ;
/**-----------------------------------------------------------------**/
/** 5.01 getDifference **/
/**-----------------------------------------------------------------**/
getDifference:
Proc ( $start_ts
, $end_ts )
returns ( char(26) );
dcl $start_ts char(26) ;
dcl @start_ts char(26) ;
dcl 1 @start based( addr(@start_ts) ) ,
3 yyyy pic'9999' ,
3 strich1 char(1) ,
3 mo pic'99' ,
3 strich2 char(1) ,
3 dd pic'99' ,
3 strich3 char(1) ,
3 hh pic'99' ,
3 punkt1 char(1) ,
3 mi pic'99' ,
3 punkt2 char(1) ,
3 ss pic'99' ,
3 punkt3 char(1) ,
3 mmmmmm pic'999999' ,
3 ende char(0) ;
dcl $end_ts char(26) ;
dcl @end_ts char(26) ;
dcl 1 @ende based( addr(@end_ts) ) ,
3 yyyy pic'9999' ,
3 strich1 char(1) ,
3 mo pic'99' ,
3 strich2 char(1) ,
3 dd pic'99' ,
3 strich3 char(1) ,
3 hh pic'99' ,
3 punkt1 char(1) ,
3 mi pic'99' ,
3 punkt2 char(1) ,
3 ss pic'99' ,
3 punkt3 char(1) ,
3 mmmmmm pic'999999' ,
3 ende char(0) ;
dcl @difference_ts char(26) init('') ;
dcl 1 @diff based( addr(@difference_ts) ) ,
3 yyyy pic'9999' ,
3 strich1 char(1) ,
3 mo pic'99' ,
3 strich2 char(1) ,
3 dd pic'99' ,
3 strich3 char(1) ,
3 hh pic'99' ,
3 punkt1 char(1) ,
3 mi pic'99' ,
3 punkt2 char(1) ,
3 ss pic'99' ,
3 punkt3 char(1) ,
3 mmmmmm pic'999999' ,
3 ende char(0) ;
dcl @isOk bit ( 1) aligned init('1'b);
@start_ts = $start_ts ;
@end_ts = $end_ts ;
@diff.yyyy = '0001' ;
@diff.strich1 = '-' ;
@diff.mo = '01' ;
@diff.strich2 = '-' ;
@diff.dd = '01' ;
@diff.strich3 = '-' ;
@diff.hh = '' ;
@diff.punkt1 = '.' ;
@diff.mi = '' ;
@diff.punkt2 = '.' ;
@diff.ss = '' ;
@diff.punkt3 = '.' ;
@diff.mmmmmm = '' ;
if aux.isPutOn then
do;
call putFrame('start','getDifference' ,80);
call putR ('** end_ts . . . . : ' ||
$end_ts ,80);
call putR ('** start_ts . . . : ' ||
$start_ts ,80);
end;
if ( @ende.mmmmmm - @start.mmmmmm >= 0 ) then
do;
@diff.mmmmmm = @ende.mmmmmm - @start.mmmmmm ;
end;
else
do;
@diff.mmmmmm = @ende.mmmmmm - @start.mmmmmm + 1000000 ;
@start.ss = @start.ss + 1 ;
end;
if ( @ende.ss - @start.ss >= 0 ) then
do;
@diff.ss = @ende.ss - @start.ss ;
end;
else
do;
@diff.ss = @ende.ss - @start.ss + 60 ;
@start.mi = @start.mi + 1 ;
end;
if ( @ende.mi - @start.mi >= 0 ) then
do;
@diff.mi = @ende.mi - @start.mi ;
end;
else
do;
@diff.mi = @ende.mi - @start.mi + 60 ;
@start.hh = @start.hh + 1 ;
end;
if ( @ende.hh - @start.hh >= 0 ) then
do;
@diff.hh = @ende.hh - @start.hh ;
end;
else
do;
@diff.hh = @ende.hh - @start.hh + 24 ;
@start.dd = @start.dd + 1 ;
end;
/**--------**/
/** Tage **/
/**--------**/
if ( @ende.dd ^= @start.dd ) then
do;
@isOk = '0'b;
end;
if ^@isOk then
do;
@difference_ts = '0001-01-01-00.00.01.000000' ;
end;
if aux.isPutOn then
do;
call putR ('** difference_ts . : ' ||
@difference_ts ,80);
call putFrame('end ','getDifference' ,80);
end;
return( @difference_ts ) ;
end getDifference ;
/**-----------------------------------------------------------------**/
/** 5.1 open_C_tracePidClientId_ok **/
/**-----------------------------------------------------------------**/
open_C_tracePidClientId_ok:
Proc
returns ( bit(1) aligned );
dcl @isOk bit(1) aligned init('1'b);
exec SQL open C_tracePidClientId ;
cPidClientOp = cPidClientOp + 1;
aux.C_tracePidClientId_open = '1'b ;
select (sqlca.sqlcode) ;
when ( 0 )
do;
/* wunderbar */
@isOk = '1'b ;
end;
otherwise
do;
aux.isPutOn = '1'b;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'open von C_tracePidClientId'
, '1010' /* traceId */
) then @isOk = '0'b ;
@isOk = '0'b ;
end;
end; /* select */
return( @isOk ) ;
end open_C_tracePidClientId_ok ;
/**-----------------------------------------------------------------**/
/** 5.1 open_C_tcd152_ok **/
/**-----------------------------------------------------------------**/
open_C_tcd152_ok:
Proc
returns ( bit(1) aligned );
dcl @isOk bit(1) aligned init('1'b);
call putFrame('start','open_C_tcd152_ok' ,70);
call putR ('** serviceId . . : ' ||
CDPUT3_serviceId ,70);
call putR ('** interfaceName : ' ||
CDPUT3_interfaceName ,70);
if noSql then
sqlCode = 0;
else
exec SQL open C_tcd152 ;
aux.C_tcd152_open = '1'b ;
select (sqlca.sqlcode) ;
when ( 0 )
do;
/* wunderbar */
@isOk = '1'b ;
end;
otherwise
do;
aux.isPutOn = '1'b;
CDPUT3_RC = 20 ;
call sqlErr(sourceLine(), 'open C_tcd152');
if is_DB2_Error
( addr( sqlca )
, 'open von C_tcd152'
, '1010' /* traceId */
) then @isOk = '0'b ;
@isOk = '0'b ;
end;
end; /* select */
call putFrame('end ','open_C_tcd152_ok' ,70);
return( @isOk ) ;
end open_C_tcd152_ok ;
/**-----------------------------------------------------------------**/
/** 5.1 close_C_tcd152_ok **/
/**-----------------------------------------------------------------**/
close_C_tcd152_ok:
Proc
returns ( bit(1) aligned );
dcl @isOk bit(1) aligned init('1'b);
/***********************/
/** Cursor C_tcd152 **/
/***********************/
if aux.C_tcd152_open then
do;
if noSql then
sqlCode = 0;
else
exec SQL close C_tcd152;
select (sqlca.sqlcode) ;
when ( 0 )
do;
/* wunderbar */
@isOk = '1'b ;
aux.C_tcd152_open = '0'b ;
end;
otherwise
do;
aux.isPutOn = '1'b;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'closing of C_tcd152'
, '1010' /* traceId */
) then @isOk = '0'b ;
@isOk = '0'b ;
end;
end; /* select */
end;
return( @isOk ) ;
end close_C_tcd152_ok ;
/**-----------------------------------------------------------------**/
/** 5.1 close_C_tracePidClientId_ok **/
/**-----------------------------------------------------------------**/
close_C_tracePidClientId_ok:
Proc
returns ( bit(1) aligned );
dcl @isOk bit(1) aligned init('1'b);
/**********************************/
/** Cursor C_tracePidClientId **/
/**********************************/
if aux.C_tracePidClientId_open then
do;
exec SQL close C_tracePidClientId;
cPidClientCl = cPidClientCL + 1;
select (sqlca.sqlcode) ;
when ( 0 )
do;
/* wunderbar */
@isOk = '1'b ;
aux.C_tracePidClientId_open = '0'b ;
end;
otherwise
do;
aux.isPutOn = '1'b;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'closing of C_tracePidClientId'
, '1010' /* traceId */
) then @isOk = '0'b ;
@isOk = '0'b ;
end;
end; /* select */
end;
return( @isOk ) ;
end close_C_tracePidClientId_ok ;
/**-----------------------------------------------------------------**/
/** 5.1 open_C_REGION_ok **/
/**-----------------------------------------------------------------**/
open_C_REGION_ok:
Proc
returns ( bit(1) aligned );
dcl @isOk bit(1) aligned init('1'b);
exec SQL open C_REGION;
aux.C_REGION_open = '1'b ;
select (sqlca.sqlcode) ;
when ( 0 )
do;
/* wunderbar */
@isOk = '1'b ;
end;
otherwise
do;
aux.isPutOn = '1'b;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'open von C_REGION'
, '1010' /* traceId */
) then @isOk = '0'b ;
@isOk = '0'b ;
end;
end; /* select */
return( @isOk ) ;
end open_C_REGION_ok ;
/**-----------------------------------------------------------------**/
/** 5.1 update_REGION_data_ok **/
/**-----------------------------------------------------------------**/
update_REGION_data_ok:
Proc
returns ( bit(1) aligned );
if aux.isPutOn then
do;
call putFrame('start'
,'update_REGION_data_ok' ,70);
end;
exec SQL
update TCD150A1
set CD150008 = current timestamp
, CD150011 = :CD150011
, CD150012 = :CD150012
where CD150001 = :CDPUT3_metaId
and CD150002 = 'REG'
and CD150003 = 'ION'
and CD150005 < :TimeStamp
and CD150006 >= :TimeStamp ;
if ( sqlca.sqlcode ^= 0 ) then
do;
aux.isPutOn = '1'b;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'Update Region-Data'
, '1010' /* traceId */
) then return('0'b);
end;
if aux.isPutOn then
do;
call putFrame('end '
,'update_REGION_data_ok' ,70);
end;
return('1'b) ;
end update_REGION_data_ok ;
/**-----------------------------------------------------------------**/
/** 5.1 fill_REGION_data_ok **/
/**-----------------------------------------------------------------**/
fill_REGION_data_ok:
Proc
returns ( bit(1) aligned );
dcl 1 feld_1 based( addr( cd150011 ) ) ,
3 r (6) , Yc
5 rName char( 8) , Yc
5 fill01 char( 1) , Yc
5 rId char( 8) , Yc
5 fill02 char( 1) , Yc
5 rPid char( 8) , Yc
5 fill03 char( 1) , Yc
5 rTime char( 12) , Yc
5 fill04 char( 1) , Yc
3 end char( 0) ; Yc
dcl 1 feld_2 based( addr( cd150012 ) ) ,
3 r (6) , Yc
5 rName char( 8) , Yc
5 fill01 char( 1) , Yc
5 rId char( 8) , Yc
5 fill02 char( 1) , Yc
5 rPid char( 8) , Yc
5 fill03 char( 1) , Yc
5 rTime char( 12) , Yc
5 fill04 char( 1) , Yc
3 end char( 0) ; Yc
if aux.isPutOn then
do;
call putFrame('start','fill_REGION_data_ok' ,70);
end;
dcl @i bin fixed(31) init(0);
call putR('** feld_2' ,70);
do @i=6 to 2 by -1 ;
feld_2(@i).rName = feld_2(@i-1).rName ;
feld_2(@i).rId = feld_2(@i-1).rId ;
feld_2(@i).rPid = feld_2(@i-1).rPid ;
feld_2(@i).rTime = feld_2(@i-1).rTime ;
if aux.isPutOn then
do;
call putR('** ' || bin31_to_char(@i) ,70);
call putR('** rName : ' ||
feld_2(@i).rName ,70);
call putR('** rId . : ' ||
feld_2(@i).rId ,70);
call putR('** rPid : ' ||
feld_2(@i).rPid ,70);
call putR('** rTime : ' ||
feld_2(@i).rTime ,70);
end;
end; /* next @i */
feld_2(1).rName = feld_1(6).rName ;
feld_2(1).rId = feld_1(6).rId ;
feld_2(1).rPid = feld_1(6).rPid ;
feld_2(1).rTime = feld_1(6).rTime ;
if aux.isPutOn then
do;
call putR('** 1' ,70);
call putR('** rName : ' ||
feld_2( 1).rName ,70);
call putR('** rId . : ' ||
feld_2( 1).rId ,70);
call putR('** rPid : ' ||
feld_2( 1).rPid ,70);
call putR('** rTime : ' ||
feld_2( 1).rTime ,70);
end;
call putR('**' ,70);
call putR('** feld_1' ,70);
do @i=6 to 2 by -1 ;
feld_1(@i).rName = feld_1(@i-1).rName ;
feld_1(@i).rId = feld_1(@i-1).rId ;
feld_1(@i).rPid = feld_1(@i-1).rPid ;
feld_1(@i).rTime = feld_1(@i-1).rTime ;
if aux.isPutOn then
do;
call putR('** ' || bin31_to_char(@i) ,70);
call putR('** rName : ' ||
feld_1(@i).rName ,70);
call putR('** rId . : ' ||
feld_1(@i).rId ,70);
call putR('** rPid : ' ||
feld_1(@i).rPid ,70);
call putR('** rTime : ' ||
feld_1(@i).rTime ,70);
end;
end; /* next @i */
if aux.isPutOn then
do;
call putR('** 1' ,70);
call putR('** rName : ' ||
feld_1( 1).rName ,70);
call putR('** rId . : ' ||
feld_1( 1).rId ,70);
call putR('** rPid : ' ||
feld_1( 1).rPid ,70);
call putR('** rTime : ' ||
feld_1( 1).rTime ,70);
end;
if ^update_REGION_data_ok () then return('0'b);
if aux.isPutOn then
do;
call putFrame('end ','fill_REGION_data_ok' ,70);
end;
return('1'b) ;
end fill_REGION_data_ok ;
1/**-----------------------------------------------------------------**/
/** 5.60 putFrame **/
/**-----------------------------------------------------------------**/
putFrame: proc( $type , $str , $pos);
dcl $type char(5);
dcl $str char(*);
dcl $pos bin fixed(31);
if ( aux.isPutOn ) then
do;
select ( $type ) ;
when ( 'start','Start','START')
do;
call putM(' ' ,$pos);
call putM('*' ,$pos);
call putR('** ' || $str ,$pos);
call putM('*' ,$pos);
call putR('**' ,$pos);
end;
otherwise
do;
call putR('**' ,$pos);
if $str ^= '' then
call putR('** End of ' || $str ,$pos);
call putR('**' ,$pos);
call putM('*' ,$pos);
end;
end; /* select ( $type ) */
end;
end putFrame ;
1/**-----------------------------------------------------------------**/
/** 5.57 is_DB2_Error **/
/**-----------------------------------------------------------------**/
is_DB2_Error: Proc ( $ptr_sqlca
, $text
, $traceId )
returns ( bit(1) aligned ) ;
dcl $ptr_sqlca ptr ;
dcl $text char(*) ;
dcl $traceId char(4) ;
dcl 1 @SQLCA based( $ptr_sqlca ) ,
%include sqlState ;
if @sqlca.sqlcode ^= 0 then
do;
if aux.isPutOn then
do;
call putM('*' ,70);
call putR('** SQL-Maske' ,70);
call putM('*' ,70);
call putR('** SQLCAID = '||@sqlca.SQLCAID ,70);
call putR('** SQLCABC = '||@sqlca.SQLCABC ,70);
call putR('** SQLCODE = '||@sqlca.sqlcode ,70);
call putR('** SQLERRM = '||@sqlca.SQLERRM ,70);
call putR('** SQLERRP = '||@sqlca.SQLERRP ,70);
call putR('** SQLERRD = '||@sqlca.SQLERRd(1) ,70);
call putR('** '||@sqlca.SQLERRd(2) ,70);
call putR('** '||@sqlca.SQLERRd(3) ,70);
call putR('** '||@sqlca.SQLERRd(4) ,70);
call putR('** '||@sqlca.SQLERRd(5) ,70);
call putR('** '||@sqlca.SQLERRd(6) ,70);
call putR('** SQLWARN = '||STRING(@sqlca.SQLWARN) ,70);
call putR('** SQLEXT = '||string(@sqlca.SQLEXT ) ,70);
call putM('*' ,70);
end;
end;
select ( @sqlca.sqlcode ) ;
when ( 0 )
do;
/* Kein Fehler */
end;
when ( 100 )
do;
/* Ist an anderer Stelle codiert. */
end;
when ( -805 )
do;
if aux.isPutOn then do;
call putM('*' ,60);
call putR('** sqlCode : -805' ,60);
call putR('** --------------' ,60);
call putR('** - DBRM nicht aktuell' ,60);
call putR('** - Collection-ID fehlt' ,60);
call putM('*' ,60);
end;
call raiseEx
( 'GLO00002'
, 'S'
, '1501'
, $traceId
, ''
, '' , '' , '' , ''
, addr(@sqlca) , null()
, 'DBRM nicht aktuell RC:-805'
);
return('1'b);
end;
when ( -904 , -923 , -924 )
do;
if aux.isPutOn then do;
call putM('*' ,60);
call putR('** DB2 nicht verfügbar RC:-904/-923/-924',60);
call putM('*' ,60);
end;
call raiseEx
( 'GLO00002'
, 'S'
, '1501'
, $traceId
, ''
, '' , '' , '' , ''
, addr(@sqlca) , null()
, $text||': DB2 nicht verfügbar RC:-904/-923/-924'
);
return('1'b);
end;
otherwise
do;
if aux.isPutOn then do;
call putM('*' ,60);
call putR('** '||$text||' DB2-Fehler RC=' ||
bin31_to_char( @sqlca.sqlcode ) ,60);
call putM('*' ,60);
end;
call raiseEx
( 'GLO00002'
, 'S'
, '1501'
, $traceId
, ''
, '' , '' , '' , ''
, addr(@sqlca) , null()
, $text || 'DB2-Fehler RC='
|| bin31_to_char( @sqlca.sqlcode )
);
return('1'b);
end;
end;
return('0'b);
end is_DB2_Error ;
1/**-----------------------------------------------------------------**/
/** 5.37 raiseEx **/
/**-----------------------------------------------------------------**/
raiseEx: Proc( @mainID
, @level
, @3270
, @traceId
, @ctx
, @param1Temp
, @param2Temp
, @param3Temp
, @param4Temp
, @pSQL
, @pIMS
, @textTemp
) ;
dcl @mainID char( 8) ;
dcl @level char( 1) ;
dcl @3270 char( 4) ;
dcl @traceId char( 4) ;
dcl @ctx char( 8) ;
dcl @param1Temp char( * ) ;
dcl @param1 char( 30) init('');
dcl @param2Temp char( * ) ;
dcl @param2 char( 30) init('');
dcl @param3Temp char( * ) ;
dcl @param3 char( 30) init('');
dcl @param4Temp char( * ) ;
dcl @param4 char( 30) init('');
dcl @pSQL ptr ;
dcl @pIMS ptr ;
dcl @textTemp char( * ) ;
dcl @text char(200) init('');
@param1 = substr( @param1Temp,1,min( 30,length(@param1Temp)) ) ;
@param2 = substr( @param2Temp,1,min( 30,length(@param2Temp)) ) ;
@param3 = substr( @param3Temp,1,min( 30,length(@param3Temp)) ) ;
@param4 = substr( @param4Temp,1,min( 30,length(@param4Temp)) ) ;
@text = substr( @textTemp ,1,min(200,length(@textTemp )) ) ;
/***************************************/
/* */
/* Exception wird nicht geschrieben. */
/* Es macht keinen Sinn, wenn yCDPUT3 */
/* Exceptions raised. */
/* */
/***************************************/
end raiseEx ;
/**-----------------------------------------------------------------**/
/** 5.05 Fill_CDADMIN_from_CDPUT **/
/**-----------------------------------------------------------------**/
Fill_CDADMIN_from_CDPUT:
proc ;
dcl @i bin fixed(31) init( 0 ) ;
if aux.isPutOn then
do;
call putFrame('start','Fill_CDADMIN_from_CDPUT' ,70);
call putR('** Folgende putFlags sind gesetzt:' ,70);
end;
/**------------------------------**/
/** Compatibility with YCDPUT1 **/
/**------------------------------**/
do;
if ( out.CDPUT3_traceLevel > 1 ) then
do;
aux.putFlag (1) = 'Y' ;
cdadmin.cdadmin_07(1) = 'Y' ;
end;
else
do;
aux.putFlag (1) = 'N' ;
cdadmin.cdadmin_07(1) = 'N' ;
end;
end;
/**--------------------------------**/
/** Umfüllen: CDPUT --> CDADMIN **/
/**--------------------------------**/
do @i=1 to 100;
select ( aux.putFlag(@i) ) ;
when ( 'Y' , 'y' , 'J' , 'j' )
do;
cdadmin.cdadmin_07(@i) = 'Y' ;
call putR('** -' || bin31_to_char3(@i) ||
'. eingeschaltet' ,70);
end;
when ( 'N' , 'n' )
do;
cdadmin.cdadmin_07(@i) = 'N' ;
call putR('** -' || bin31_to_char3(@i) ||
'. ausgeschaltet' ,70);
end;
otherwise
do;
/* no action */
end;
end; /* select */
end; /* next */
cdadmin_traceLevel = out.CDPUT3_traceLevel ;
cdadmin_compName( 1) = tcd152.componentName_01 ;
cdadmin_compName( 2) = tcd152.componentName_02 ;
cdadmin_compName( 3) = tcd152.componentName_03 ;
cdadmin_compName( 4) = tcd152.componentName_04 ;
cdadmin_compName( 5) = tcd152.componentName_05 ;
cdadmin_compName( 6) = tcd152.componentName_06 ;
cdadmin_compName( 7) = tcd152.componentName_07 ;
cdadmin_compName( 8) = tcd152.componentName_08 ;
cdadmin_compName( 9) = tcd152.componentName_09 ;
cdadmin_compName(10) = tcd152.componentName_10 ;
cdadmin_compTLvl( 1) = tcd152.componentTLvl_01 ;
cdadmin_compTLvl( 2) = tcd152.componentTLvl_02 ;
cdadmin_compTLvl( 3) = tcd152.componentTLvl_03 ;
cdadmin_compTLvl( 4) = tcd152.componentTLvl_04 ;
cdadmin_compTLvl( 5) = tcd152.componentTLvl_05 ;
cdadmin_compTLvl( 6) = tcd152.componentTLvl_06 ;
cdadmin_compTLvl( 7) = tcd152.componentTLvl_07 ;
cdadmin_compTLvl( 8) = tcd152.componentTLvl_08 ;
cdadmin_compTLvl( 9) = tcd152.componentTLvl_09 ;
cdadmin_compTLvl(10) = tcd152.componentTLvl_10 ;
if aux.isPutOn then
do;
call putFrame('end ','Fill_CDADMIN_from_CDPUT' ,70);
end;
end; /* Fill_CDADMIN_from_CDPUT */
1/**-----------------------------------------------------------------**/
/** 5.03 isHeading_ok MDL093 2008-03-19 **/
/**-----------------------------------------------------------------**/
isHeading_ok:
proc ( $moduleName
, $pid )
returns ( bit(1)aligned ) ;
dcl $moduleName char(8) ;
dcl $pid char(8) ;
dcl @isOk bit (1)aligned init('1'b) ;
if aux.isPutOn then
do;
call putM(' ' ,79);
call putM('*' ,79);
call putM('*' ,79);
call putR('**' ,79);
call putR('** Start of '||$moduleName||' on ' ||
translate('rbcd-ef-gh at ij:kl'
, datetime()
,'rbcdefghijklmnopq'
) ,79);
call putR('**' ,79);
call putM('*' ,79);
call putM('*' ,79);
call putM(' ' ,79);
call putM('*' ,79);
call putR('**' ,79);
call putR('** ' || COMP_VERS ,79);
call putR('** ' || COMP_TIME ,79);
call putR('**' ,79);
call putR('** PID : ' ||
$pid ,79);
call putR('**' ,79);
call putM('*' ,79);
end;
return( @isOk ) ;
end /* isHeading_ok */ ;
/**-----------------------------------------------------------------**/
/** 5.1 set_default_output_values_ok **/
/**-----------------------------------------------------------------**/
set_default_output_values_ok:
Proc
returns ( bit(1) aligned ) ;
if aux.isPutOn then
do;
call putFrame('start'
,'set_default_output_values_ok' ,70);
end;
/**-----------------**/
/** Default-Werte **/
/**-----------------**/
do;
yCDPUT3k.out.CDPUT3_rc = 0 ;
yCDPUT3k.out.CDPUT3_traceLevel = 0 ;
yCDPUT3k.out.CDPUT3_traceLevelModule = 0 ;
yCDPUT3k.out.CDPUT3_pid( * ) = '' ;
yCDPUT3k.out.CDPUT3_inOrExclude = '' ;
yCDPUT3k.out.CDPUT3_clientIdA (*) = '' ;
yCDPUT3k.out.CDPUT3_forApplUse(*) = '' ;
end;
if aux.isPutOn then
do;
call putFrame('end '
,'set_default_output_values_ok' ,70);
end;
return('1'b);
end set_default_output_values_ok ;
/**-----------------------------------------------------------------**/
/** 5.05 getTraceLevelForPgmName_ok **/
/**-----------------------------------------------------------------**/
getTraceLevelForPgmName_ok:
proc ( $ptr_itofpn )
returns( bit(1)aligned );
dcl $ptr_itofpn ptr ;
dcl
1 @itofpn based( $ptr_itofpn ) ,
3 i ,
5 traceLevelMainPgm bin fixed(31) ,
5 moduleName char(8) ,
3 o ,
5 traceLevel bin fixed(31) ,
3 endOfStruc char(0) ;
dcl @isOk bit (1)aligned init('1'b) ;
dcl @i bin fixed(31) init( 0 ) ;
if aux.isPutOn then
do;
call putFrame ('start','getTraceLevelForPgmName_ok' ,70);
call putR ('** moduleName . : ' ||
@itofpn.i.moduleName ,70);
call putR ('**' ,70);
call putR ('** traceLevel (general) : ' ||
bin31_to_char(@itofpn.i.traceLevelMainPgm) ,70);
end;
@itofpn.o.traceLevel = @itofpn.i.traceLevelMainPgm ;
/*
if ( @itofpn.o.traceLevel > 0 ) then
do;
*/
call putR ('**' ,70);
do @i=1 to 10
while (cdadmin_compName(@i) ^= @itofpn.i.moduleName);
end;
call putR ('** Search for moduleName ' ||
@itofpn.i.moduleName || ' in table ...' ,70);
if ( @i = 11 ) then
do;
call putR ('** ... moduleName ' ||
@itofpn.i.moduleName || ' not found in table' ,70);
if ( @itofpn.o.traceLevel > 0 ) then
do;
aux.isPutOn = '1'b;
call putR ('** Trace is on because of' ||
' traceLevelMainPgm : ' ||
bin31_to_char(@itofpn.i.traceLevelMainPgm) ,70);
end;
end;
else
do;
call putR ('** ... moduleName ' ||
@itofpn.i.moduleName || ' found in table' ,70);
select ( cdadmin_compTLvl(@i) );
when ( ' ' )
do;
call putR ('** ... no traceLevel specified' ,70);
end;
when ( '0','1','2','3','4','5','6','7','8','9' )
do;
@itofpn.o.traceLevel =
char1_to_bin31(cdadmin_compTLvl(@i),0);
if ( @itofpn.o.traceLevel > 0 ) then aux.isPutOn = '1'b;
call putR ('** traceLevel . : ' ||
cdadmin_compTLvl(@i) ,70);
end;
otherwise
do;
aux.isPutOn = '1'b;
call putR ('** ... wrong traceLevel specified : ' ||
cdadmin_compTLvl(@i) ,70);
end;
end; /* select */
end;
/*
end;
*/
if aux.isPutOn then
do;
call putR ('**' ,70);
call putR ('** traceLevel : ' ||
bin31_to_char(@itofpn.o.traceLevel) ,70);
call putFrame('end ','getTraceLevelForPgmName_ok' ,70);
end;
return( @isOk );
end /* getTraceLevelForPgmName_ok */ ;
CDADMINP
/**-----------------------------------------------------------------**/
/** 5.42 Footing **/
/**-----------------------------------------------------------------**/
Footing:
proc ( @pgmName ) ;
dcl @pgmName char(8) ;
if aux.isPutOn then
do;
call putM(' ' ,79);
call putM('*' ,79);
call putM('*' ,79);
call putR('**' ,79);
call putR('** End of '||@pgmName||' on ' ||
translate('gh.ef.rbcd at ij:kl'
, datetime()
,'rbcdefghijklmnopq'
) ,79);
call putR('**' ,79);
call putM('*' ,79);
call putM('*' ,79);
call putM(' ' ,79);
end;
end Footing ;
1/**-----------------------------------------------------------------**/
/** 5.38 putIP MDL153 2008-03-07 **/
/**-----------------------------------------------------------------**/
putIP:
proc( $i
, $m )
returns ( char(40)var );
dcl $i bin fixed(31) ;
dcl $m bin fixed(31) ;
dcl @out char (40)var init('') ;
@out = bin31_to_char($i) ||
' (Possible: ' ||
bin31_to_char($m) ||
')' ;
return(@out) ;
end; /* putIP */
/**-----------------------------------------------------------------**/
/** 5.42 getTraceRegionForPid **/
/**-----------------------------------------------------------------**/
getTraceRegionForPid:
proc ( $ptr_gtrfp )
returns ( bit(1)aligned );
dcl $ptr_gtrfp ptr ;
dcl
1 @gtrfp based ( $ptr_gtrfp) ,
3 i ,
5 pid char( 8) ,
3 o ,
5 hasFound bit ( 1)aligned ,
5 getRegion char( 1) ,
5 traceLevel bin fixed(31) ,
5 padd_01 char( 1) ,
3 endOfStruc char( 0) ;
dcl @i bin fixed(31) init(0) ;
dcl @m bin fixed(31) init(0) ;
dcl @isOk bit(1)aligned init('1'b);
call putFrame('start','getTraceRegionForPid' ,70);
call putR ('** input' ,70);
call putR ('** pid . . . : ' ||
@gtrfp.i.pid ,70);
/**------------**/
/** pidStruc **/
/**------------**/
do;
dcl
1 @pidStruc based( addr (tcd152.pid_01) ) ,
3 a(10) ,
5 pid char( 8) ,
5 clientId char(10) ,
5 traceLvl char( 1) ,
5 getRegion char( 1) ,
3 endOfStruc char( 0) ;
@m = hbound(@pidStruc.a,1) ;
do @i=1 to @m
while( @pidStruc.a(@i).pid ^= @gtrfp.i.pid ) ;
end;
if ( @pidStruc.a(@i).pid = @gtrfp.i.pid ) then
do;
@gtrfp.o.hasFound = '1'b ;
@gtrfp.o.getRegion = @pidStruc.a(@i).getRegion ;
@gtrfp.o.traceLevel = Char1_To_Bin31
( @pidStruc.a(@i).traceLvl , 0) ;
end;
else
do;
@gtrfp.o.hasFound = '0'b ;
end;
end;
if ( @gtrfp.o.traceLevel > 0 ) then
do;
aux.isPutOn = '1'b ;
call putR('** trace is switched on by explicit' ||
' userPid' ,70);
call putR('** on TCD152.' ,70);
call putR('** userPid : ' ||
@gtrfp.i.pid ,70);
end;
if ( aux.isPutOn ) then
do;
call putR ('** output' ,70);
call putR ('** hasFound . : ' ||
@gtrfp.o.hasFound ,70);
call putR ('** getRegion : ' ||
@gtrfp.o.getRegion ,70);
call putR ('** traceLevel : ' ||
bin31_to_char(@gtrfp.o.traceLevel) ,70);
call putFrame('end ','getTraceRegionForPid' ,70);
end;
return( @isOk );
end getTraceRegionForPid ;
/**-----------------------------------------------------------------**/
/** 5.42 getTraceRegionForClientId **/
/**-----------------------------------------------------------------**/
getTraceRegionForClientId:
proc ( $ptr_gtrfc )
returns ( bit(1)aligned );
dcl $ptr_gtrfc ptr ;
dcl
1 @gtrfc based ( $ptr_gtrfc) ,
3 i ,
5 clientId char(10) ,
3 o ,
5 hasFound bit ( 1)aligned ,
5 getRegion char( 1) ,
5 traceLevel bin fixed(31) ,
5 padd_01 char( 1) ,
3 endOfStruc char( 0) ;
dcl @i bin fixed(31) init(0) ;
dcl @m bin fixed(31) init(0) ;
dcl @isOk bit(1)aligned init('1'b);
call putFrame('start','getTraceRegionForClientId' ,70);
call putR ('** input' ,70);
call putR ('** clientId . : ' ||
@gtrfc.i.clientId ,70);
/**------------**/
/** pidStruc **/
/**------------**/
do;
dcl
1 @pidStruc based( addr (tcd152.pid_01) ) ,
3 a(10) ,
5 pid char( 8) ,
5 clientId char(10) ,
5 traceLvl char( 1) ,
5 getRegion char( 1) ,
3 endOfStruc char( 0) ;
@m = hbound(@pidStruc.a,1) ;
do @i=1 to @m
while( @pidStruc.a(@i).clientId ^= @gtrfc.i.clientId ) ;
end;
if ( @pidStruc.a(@i).clientId = @gtrfc.i.clientId
& @pidStruc.a(@i).clientId ^= '' ) then /* mn@20120913 */
do;
@gtrfc.o.hasFound = '1'b ;
@gtrfc.o.getRegion = @pidStruc.a(@i).getRegion ;
@gtrfc.o.traceLevel = Char1_To_Bin31
( @pidStruc.a(@i).traceLvl , 0) ;
end;
else
do;
@gtrfc.o.hasFound = '0'b ;
end;
end;
if ( @gtrfc.o.traceLevel > 0 ) then
do;
aux.isPutOn = '1'b ;
call putR('** trace is switched on by explicit' ||
' clientId' ,70);
call putR('** on TCD152.' ,70);
call putR('** clientId : ' ||
@gtrfc.i.clientId ,70);
end;
if ( aux.isPutOn ) then
do;
call putR ('** output' ,70);
call putR ('** hasFound . : ' ||
@gtrfc.o.hasFound ,70);
call putR ('** getRegion : ' ||
@gtrfc.o.getRegion ,70);
call putR ('** traceLevel : ' ||
bin31_to_char(@gtrfc.o.traceLevel) ,70);
call putFrame('end ','getTraceRegionForClientId' ,70);
end;
return( @isOk );
end getTraceRegionForClientId ;
1/**-----------------------------------------------------------------**/
/** 5.05 Char_To_Bin31 MDL155 2008-05-16 **/
/**-----------------------------------------------------------------**/
Char_To_Bin31:
proc ( $charVar
, $errorCd )
returns ( bin fixed (31) );
dcl $charVar char ( 5 ) varying ;
dcl $errorCd bin fixed(31) ;
dcl @bin31 bin fixed(31) init( 0 ) ;
dcl @char1 char(1) init( '') ;
dcl @char2 char(2) init( '') ;
/* This function converts char(1) to bin fixed(31) */
/* In case of a conversion error the value of $errorCd */
/* is returned. */
call putFrame('start','Char_To_Bin31' ,80);
call putR('$charVar 1 : ' ||
$charVar ,80);
$charVar = trim ( $charVar ) ;
call putR('$charVar 2 : ' ||
$charVar ,80);
Select ( length($charVar) ) ;
when ( 1 )
do;
@char1 = $charVar ;
@bin31 = Char1_To_Bin31 ( @char1 , $errorCd ) ;
end;
when ( 2 )
do;
@char2 = $charVar ;
@bin31 = Char2_To_Bin31 ( @char2 , $errorCd ) ;
end;
otherwise
do;
@bin31 = $errorCd ;
end;
end; /* Select ( length($charVar) ) */
call putR('@bin31 . : ' ||
@bin31 ,80);
call putFrame('end ','Char_To_Bin31' ,80);
return ( @bin31 ) ;
end ; /* Char_To_Bin31 */
1/**-----------------------------------------------------------------**/
/** 5.05 Char1_To_Bin31 MDL135 2007-08-13 **/
/**-----------------------------------------------------------------**/
Char1_To_Bin31:
proc ( $char1
, $errorCd )
returns ( bin fixed (31) );
dcl $char1 char ( 1 ) ;
dcl @pic1 pic '9' based(addr($char1));
dcl $errorCd bin fixed(31) ;
dcl @bin31 bin fixed(31) init(0) ;
/* This function converts char(1) to bin fixed(31) */
/* In case of a conversion error the value of $errorCd */
/* is returned. */
on conversion
begin;
@bin31 = $errorCd ;
goto ende;
end; /* conversion */
@bin31 = @pic1 ;
revert conversion ;
ende:
return ( @bin31 ) ;
end ; /* Char1_To_Bin31 */
1/**-----------------------------------------------------------------**/
/** 5.05 Char2_To_Bin31 MDL151 2008-05-16 **/
/**-----------------------------------------------------------------**/
Char2_To_Bin31:
proc ( $Char2
, $errorCd )
returns ( bin fixed (31) );
dcl $Char2 char ( 2 ) ;
dcl @picz9 pic'Z9' based (addr($Char2)) ;
dcl $errorCd bin fixed(31) ;
dcl @bin31 bin fixed(31) init(0) ;
/* This function converts char(1) to bin fixed(31) */
/* In case of a conversion error the value of $errorCd */
/* is returned. */
on conversion
begin;
@bin31 = $errorCd ;
goto ende;
end; /* conversion */
@bin31 = @picz9 ;
revert conversion ;
ende:
return ( @bin31 ) ;
end ; /* Char2_To_Bin31 */
1/**-----------------------------------------------------------------**/
/** 5.07 TraceLevel1TimeDifference_Ok MDL152 2008-09-17 **/
/**-----------------------------------------------------------------**/
TraceLevel1TimeDifference_Ok:
proc ( $point
, $prevTs
, $traceLevel )
returns ( bit(1) aligned );
dcl $point char( 25 ) ;
dcl $prevTs char( 26 ) ;
dcl $traceLevel bin fixed(31) ;
dcl @puts bit(1) aligned init('0'b);
dcl
1 @prevPic based(addr($prevTs)) ,
3 yyyy pic'9999' ,
3 mo pic '99' ,
3 dd pic '99' ,
3 hh pic '99' ,
3 mm pic '99' ,
3 ss pic '99' ,
3 ttt pic '999' ;
dcl @actTs char( 17 ) ;
dcl
1 @actPic based(addr(@actTs)) ,
3 yyyy pic'9999' ,
3 mo pic '99' ,
3 dd pic '99' ,
3 hh pic '99' ,
3 mm pic '99' ,
3 ss pic '99' ,
3 ttt pic '999' ;
dcl @difference char( 12 ) init('00:00:00:000') ;
dcl
1 @diffPic based(addr(@difference)) ,
3 hh pic '99' ,
3 fill_hh char(1) ,
3 mm pic '99' ,
3 fill_mm char(1) ,
3 ss pic '99' ,
3 fill_ss char(1) ,
3 ttt pic '999' ;
/**-------------------**/
/** Trace-Level = 1 **/
/**-------------------**/
if ( $traceLevel = 1 ) then
do;
@puts = aux.isPutOn ;
aux.isPutOn = '1'b ;
if ( $prevTs = '' ) then
do;
$prevTs = dateTime ;
call putM ('*' ,70);
call putR ('**' ,70);
call putR ('** Trace-Level 1' ,70);
call putR ('** =============' ,70);
call putR ('** Point TimeDifference' ,70);
call putR ('** ----- --------------' ,70);
call putR ('** Start ' ,70);
end;
do;
@actTs = dateTime ;
/** Thousendths of Seconds **/
/** ---------------------- **/
do;
if ( @actPic.ttt - @prevPic.ttt >= 0 ) then
do;
@diffPic.ttt = @actPic.ttt - @prevPic.ttt ;
end;
else
do;
@diffPic.ttt = 1000 + @actPic.ttt - @prevPic.ttt ;
@prevPic.ss = @prevPic.ss + 1 ;
end;
end;
/** Seconds **/
/** ------- **/
do;
if ( @actPic.ss - @prevPic.ss >= 0 ) then
do;
@diffPic.ss = @actPic.ss - @prevPic.ss ;
end;
else
do;
@diffPic.ss = 60 + @actPic.ss - @prevPic.ss ;
@prevPic.mm = @prevPic.mm + 1 ;
end;
end;
/** Minutes **/
/** ------- **/
do;
if ( @actPic.mm - @prevPic.mm >= 0 ) then
do;
@diffPic.mm = @actPic.mm - @prevPic.mm ;
end;
else
do;
@diffPic.mm = 60 + @actPic.mm - @prevPic.mm ;
@prevPic.hh = @prevPic.hh + 1 ;
end;
end;
/** Hours **/
/** ----- **/
do;
if ( @actPic.hh - @prevPic.hh >= 0 ) then
do;
@diffPic.hh = @actPic.hh - @prevPic.hh ;
end;
else
do;
@diffPic.hh = 60 + @actPic.hh - @prevPic.hh ;
@prevPic.dd = @prevPic.dd + 1 ;
end;
end;
call putR ('** ' || $point || @difference ,70);
$prevTs = @actTs ;
end;
aux.isPutOn = @puts ;
end;
return('1'b);
end /* TraceLevel1TimeDifference_Ok */ ;
/**-----------------------------------------------------------------**/
/** 5.42 processType_1 **/
/**-----------------------------------------------------------------**/
processType_1:
proc
returns ( bit(1)aligned );
dcl @isOk bit(1)aligned init('1'b);
call putFrame('start','processType_1' ,70);
/**-------------------**/
/** Initialization **/
/**-------------------**/
do;
out.CDPUT3_rc = 0 ;
out.CDPUT3_traceLevel = 0 ;
out.CDPUT3_fillTcd153 = 'N' ;
out.CDPUT3_pid(*) = '' ;
out.CDPUT3_inOrExclude = '' ;
out.CDPUT3_clientIdA(*) = '' ;
out.CDPUT3_forApplUse(*) = '' ;
tcd152 = '' ;
end;
/* Am Anfang wegen cdadmin_sysprint */
if plausi_input_fields_ok () then
do;
if set_default_output_values_ok () then
do;
/**------------------------**/
/** getDataFromTCD152_ok **/
/**------------------------**/
dcl 1 @getTcd152 ,
3 i ,
5 dummy char( 0) init('') ,
3 o ,
5 getRegionName char( 1) init('') ,
5 hasFound bit(1)aligned init('') ,
5 padd_01 char( 2) init('') ,
5 end char( 0) init('') ;
if ^getDataFromTCD152_ok (addr(@getTcd152)) then
do;
@isOk = '0'b ;
CDPUT3_rc = 99 ;
end;
else
do;
/**----------------------------**/
/** insert_missing_tcd152_ok **/
/**----------------------------**/
if ^@getTcd152.o.hasFound then
do;
end;
if ( @getTcd152.o.hasFound
& @isOk ) then
do;
/* not necessary. see below |
out.CDPUT3_traceLevel = tcd152.traceLvlAll ;
out.CDPUT3_fillTcd153 = tcd152.getRegionAll ;
*/
/**------------------------**/
/** getTraceRegionForPid **/
/**------------------------**/
dcl
1 @gtrfp ,
3 i ,
5 pid char( 8) init( '' ) ,
3 o ,
5 hasFound bit ( 1)aligned init('0'b) ,
5 getRegion char( 1) init( '' ) ,
5 traceLevel bin fixed(31) init( 0 ) ,
5 padd_01 char( 1) init( '' ) ,
3 endOfStruc char( 0) init( '' ) ;
@gtrfp.i.pid = in.CDPUT3_pid ;
if ^getTraceRegionForPid (addr(@gtrfp)) then
do;
@isOk = '0'b ;
CDPUT3_rc = 99 ;
end;
else
do;
if ( @gtrfp.o.hasFound ) then
do;
call putR('**' ,70);
call putR('** PID found -> ' ||
'no need to check Client-IDs' ,70);
call putR('**' ,70);
out.CDPUT3_traceLevel = @gtrfp.o.traceLevel ;
out.CDPUT3_fillTcd153 = @gtrfp.o.getRegion ;
end;
else
do;
/**-----------------------------**/
/** getTraceRegionForClientId **/
/**-----------------------------**/
dcl
1 @gtrfc ,
3 i ,
5 clientId char(10) init( '' ) ,
3 o ,
5 hasFound bit ( 1)aligned init('0'b) ,
5 getRegion char( 1) init( '' ) ,
5 traceLevel bin fixed(31) init( '' ) ,
5 padd_01 char( 1) init( '' ) ,
3 endOfStruc char( 0) init( '' ) ;
@gtrfc.i.clientId = in.CDPUT3_clientId ;
if ^getTraceRegionForClientId (addr(@gtrfc)) then
do;
@isOk = '0'b ;
CDPUT3_rc = 99 ;
end;
else
do;
if ( @gtrfc.o.hasFound ) then
do;
out.CDPUT3_traceLevel = @gtrfc.o.traceLevel ;
out.CDPUT3_fillTcd153 = @gtrfc.o.getRegion ;
end;
else
do;
out.CDPUT3_traceLevel =
Char1_To_Bin31( tcd152.traceLvlAll , 0) ;
out.CDPUT3_fillTcd153 = tcd152.getRegionAll ;
if ( out.CDPUT3_traceLevel > 0 ) then
do;
aux.isPutOn = '1'b ;
call putR('** trace is switched on by' ||
' type "all"' ,70);
end;
end;
end;
end;
end;
end;
end; /* getDataFromTCD152_ok */
end; /* set_default_output_values_ok */
end; /* plausi_input_fields_ok */
if ( out.CDPUT3_traceLevel = 0 ) then
do;
/**--------------------------------**/
/** getPidClientIdFromTCD150_ok **/
/**--------------------------------**/
if TraceLevel1TimeDifference_Ok
( 'before TCD150'
, aux.ts /* by reference */
, in.CDPUT3_traceLevel
) then;
do; /* getPidClientIdFromTCD150_ok */
dcl 1 @gpcif ,
3 i ,
5 pid char( 8) init('') ,
5 clientId char(10) init('') ,
5 padd_01 char( 2) init('') ,
3 o ,
5 hasFound bit(1)aligned init('') ,
5 padd_01 char( 3) init('') ,
5 traceLevel bin fixed(31) init( 0) ,
5 getRegionName char( 1) init('') ,
5 padd_02 char( 3) init('') ,
5 endOfStruc char( 0) init('') ;
@gpcif.i.pid = in.CDPUT3_pid ;
@gpcif.i.clientId = CDPUT3_clientId ;
if ^getPidClientIdFromTCD150_ok (addr(@gpcif)) then
do;
@isOk = '0'b ;
CDPUT3_rc = 99 ;
end;
else
do;
if ( @gpcif.o.hasFound ) then
do;
call putR('**' ,70);
call putR('** Trace on for all services.' ,70);
call putR('**' ,70);
out.CDPUT3_traceLevel = @gpcif.o.traceLevel ;
out.CDPUT3_fillTcd153 = @gpcif.o.getRegionName ;
end;
end;
end; /* getPidClientIdFromTCD150_ok */
if TraceLevel1TimeDifference_Ok
( 'after TCD150'
, aux.ts /* by reference */
, in.CDPUT3_traceLevel
) then;
end;
call Fill_CDADMIN_from_CDPUT ;
if ( isFlagOn(out.CDPUT3_filltcd153) ) then
do;
if fill_tcd153_struc_ok () then
do;
end; /* fill_tcd153_struc_ok */
end;
dcl @i bin fixed(31) init(0);
if aux.isPutOn then
do;
call putR ('**' ,70);
call putR ('** output' ,70);
call putR ('** rc . . . . . . . : ' ||
bin31_to_char(out.CDPUT3_rc) ,70);
call putR ('** traceLevel . . . : ' ||
bin31_to_char(out.CDPUT3_traceLevel) ,70);
call putR ('** fillTcd153 . . . : ' ||
out.CDPUT3_fillTcd153 ,70);
call putR ('** clientId' ,70);
call putR ('** inOrExclude . . : ' ||
out.CDPUT3_inOrExclude ,70);
call putR ('** clientIdA' ,70);
do @i=1 to 10 while( out.CDPUT3_clientIdA(@i)^='');
call putR ('** ' || putIP(@i,10) ,70);
call putR ('** clientIdA . : ' ||
out.CDPUT3_clientIdA (@i) ,70);
end;
if @i=1 then
do;
call putR ('** none' ,70);
end;
call putR ('** forApplUse' ,70);
do @i=1 to 3;
call putR ('** ' || putIP(@i,3) ,70);
call putR ('** forApplUse . : ' ||
out.CDPUT3_forApplUse(@i) ,70);
end;
call putR ('** CDADMIN' ,70);
call putR ('** traceLevel . . : ' ||
bin31_to_char(cdadmin_traceLevel) ,70);
call putFrame('end ','processType_1' ,70);
end;
return( @isOk );
end processType_1 ;
1/**-----------------------------------------------------------------**/
/** 5.40 isFlagOn MDL184 2010-05-07 **/
/**-----------------------------------------------------------------**/
isFlagOn:
proc ( $char_1 )
returns( bit(1) );
dcl $char_1 char(1) ;
if ( $char_1 = 'Y'
| $char_1 = 'y'
| $char_1 = 'J'
| $char_1 = 'j' ) then
do;
return('1'b);
end;
else
do;
return('0'b);
end;
end /* isFlagOn */ ;
/**-----------------------------------------------------------------**/
/** 5.42 processType_3 **/
/**-----------------------------------------------------------------**/
processType_3:
proc returns( bit(1)aligned );
dcl @isOk bit(1)aligned init('1'b);
if aux.isPutOn then
do;
call putFrame('start','processType_3' ,70);
end;
/* Am Anfang wegen cdadmin_sysprint */
if plausi_input_fields_ok () then
do;
call putR ('** fillTcd153 : ' ||
in.CDPUT3_filltcd153 ,70);
if ( isFlagOn(in.CDPUT3_filltcd153) ) then
do;
if fill_tcd153_struc_ok () then
do;
end; /* fill_tcd153_struc_ok */
if ( yCDPUT3k.CDPUT3_isExpress ) then
do;
end;
else
do;
end;
end;
end;
if aux.isPutOn then
do;
call putFrame('end ','processType_3' ,70);
end;
return ( @isOk ) ;
end processType_3 ;
/**-----------------------------------------------------------------**/
/** 5.42 processType_2 **/
/**-----------------------------------------------------------------**/
processType_2:
proc
returns ( bit(1)aligned ) ;
dcl @isOk bit(1)aligned init('1'b);
/* Am Anfang wegen cdadmin_sysprint */
if plausi_input_fields_ok () then
do;
/* darf nicht ausgeführt werden.
applUse wird überschrieben.
if set_default_output_values_ok () then
do; */
if (in.CDPUT3_ptrCdadmin = null()) then
do;
yCDPUT3k.out.CDPUT3_traceLevelModule = 0 ;
end;
else
do;
dcl
1 @itofpn ,
3 i ,
5 traceLevelMainPgm bin fixed(31) init('') ,
5 moduleName char(8) init('') ,
3 o ,
5 traceLevel bin fixed(31) init( 0) ,
3 endOfStruc char(0) init('') ;
@itofpn.i.traceLevelMainPgm = cdadmin_traceLevel ;
@itofpn.i.moduleName = CDPUT3_pgmName ;
if ( getTraceLevelForPgmName_ok(addr( @itofpn ))) then
do;
yCDPUT3k.out.CDPUT3_traceLevelModule = @itofpn.o.traceLevel ;
end;
else
do;
yCDPUT3k.out.CDPUT3_traceLevelModule = 0 ;
end;
end;
/*
end; /* set_default_output_values_ok */
end; /* plausi_input_fields_ok */
dcl @i bin fixed(31) init(0);
if aux.isPutOn then
do;
call putR ('**' ,70);
call putR ('** output for ' || @itofpn.i.moduleName ,70);
call putR ('** rc . . . . : ' ||
bin31_to_char(out.CDPUT3_rc) ,70);
call putR ('** traceLevel : ' ||
bin31_to_char(out.CDPUT3_traceLevelModule) ,70);
end;
return ( @isOk );
end processType_2 ;
selectTcd152Into: proc;
tcd152.SERVICEID = '???';
tcd152.INTERFACENAME = '???';
if noSql then
sqlCode = 0;
else
exec sql
select %include TCD152F;
, current timestamp
, dayOfWeek( current date )
into :TCD152
from TCD152A1
where serviceId = :CDPUT3_serviceId
and interfaceName = :CDPUT3_interfaceName
;
if sqlCode = 0 then do
c152SelInto = c152SelInto + 1;
if tcd152.SERVICEID <> CDPUT3_serviceId & ^noSql then
put ('sId <>' || tcd152.SERVICEID
|| '<>' || cdPut3_SERVICEID) skip;
if tcd152.interfaceName <> CDPUT3_interfaceName & ^noSql then
put ('sId <>' || tcd152.interfaceName
|| '<>' || cdPut3_interfaceName) skip;
end;
else do;
call sqlErr(sourceLine(), 'selectTcd152Into');
end ;
end selectTcd152Into;
selectPidClientInto:
Proc ( $p_ftpc )
returns ( bit(1) aligned );
dcl $p_ftpc ptr ;
dcl 1 @ftpc based ($p_ftpc) ,
3 i ,
5 userPid char( 8) ,
5 clientId char(10) ,
5 padd_01 char( 2) ,
3 o ,
5 hasFound bit ( 1) aligned ,
5 padd_01 char( 3) ,
5 uSwitch bin fixed(31) ,
/* 1 : userPid found */
/* 2 : clientId found */
5 userPid char( 8) ,
5 clientId char(10) ,
5 padd_02 char( 2) ,
3 endOfStruc char( 0) ;
exec SQL
select %include TCD150F;
into :TCD150
from TCD150A1
where CD150001 = 'TRACE'
and
( ( CD150002 = 'CLIE'
and CD150003 = 'NTID'
)
or
(
CD150002 = 'PID '
and CD150003 = ' '
)
)
and
( substr(cd150011, 1, 8) = :@ftpc.i.userPid
or substr(cd150011, 1, 10) = :@ftpc.i.clientId
)
and CD150005 < :TimeStamp
and CD150006 >= :TimeStamp
fetch first 1 row only
;
cPidClientInto = cPidClientInto + 1;
select ( sqlca.sqlcode ) ;
when ( 0 )
do;
select;
when ( @ftpc.i.userPid = substr(tcd150.cd150011,1,8) )
do;
@ftpc.o.hasFound = '1'b ;
@ftpc.o.uSwitch = 1 ;
@ftpc.o.userPid = substr(tcd150.cd150011,1,8) ;
aux.isPutOn = '1'b ;
call putR('** getRegionName is switched on by' ||
' userPid' ,70);
call putR('** on TCD150.' ,70);
end;
when ( @ftpc.i.clientId = substr(tcd150.cd150011,1,10) )
do;
@ftpc.o.hasFound = '1'b ;
@ftpc.o.uSwitch = 2 ;
@ftpc.o.clientId = substr(tcd150.cd150011,1,10) ;
aux.isPutOn = '1'b ;
call putR('** getRegionName is switched on by' ||
' clientId' ,70);
call putR('** on TCD150.' ,70);
end;
otherwise
do;
put ('pidClient bad row found |||||') skip;
return ('0'b);
end;
end; /* select */
end;
when ( 100 )
do;
@ftpc.o.hasFound = '0'b;
end;
otherwise
do;
call sqlErr(sourceLine(), 'selectPidClientInto');
end;
end; /* select sqlCode */
return ('1'b);
end selectPidClientInto;
selectPidClientIxOnly:
Proc ( $p_ftpc )
returns ( bit(1) aligned );
dcl $p_ftpc ptr ;
dcl 1 @ftpc based ($p_ftpc) ,
3 i ,
5 userPid char( 8) ,
5 clientId char(10) ,
5 padd_01 char( 2) ,
3 o ,
5 hasFound bit ( 1) aligned ,
5 padd_01 char( 3) ,
5 uSwitch bin fixed(31) ,
/* 1 : userPid found */
/* 2 : clientId found */
5 userPid char( 8) ,
5 clientId char(10) ,
5 padd_02 char( 2) ,
3 endOfStruc char( 0) ;
exec SQL
select cd150011
into :tcd150.cd150011
from TCD150A1
where CD150001 = 'TRACE'
and
( ( CD150002 = 'CLIE'
and CD150003 = 'NTID'
)
or
(
CD150002 = 'PID '
and CD150003 = ' '
)
)
and
( substr(cd150011, 1, 8) = :@ftpc.i.userPid
or substr(cd150011, 1, 10) = :@ftpc.i.clientId
)
and CD150005 < :TimeStamp
and CD150006 >= :TimeStamp
fetch first 1 row only
;
cPidClientInto = cPidClientInto + 1;
select ( sqlca.sqlcode ) ;
when ( 0 )
do;
select;
when ( @ftpc.i.userPid = substr(tcd150.cd150011,1,8) )
do;
@ftpc.o.hasFound = '1'b ;
@ftpc.o.uSwitch = 1 ;
@ftpc.o.userPid = substr(tcd150.cd150011,1,8) ;
aux.isPutOn = '1'b ;
call putR('** getRegionName is switched on by' ||
' userPid' ,70);
call putR('** on TCD150.' ,70);
end;
when ( @ftpc.i.clientId = substr(tcd150.cd150011,1,10) )
do;
@ftpc.o.hasFound = '1'b ;
@ftpc.o.uSwitch = 2 ;
@ftpc.o.clientId = substr(tcd150.cd150011,1,10) ;
aux.isPutOn = '1'b ;
call putR('** getRegionName is switched on by' ||
' clientId' ,70);
call putR('** on TCD150.' ,70);
end;
otherwise
do;
put ('pidClient bad row found |||||') skip;
return ('0'b);
end;
end; /* select */
end;
when ( 100 )
do;
@ftpc.o.hasFound = '0'b;
end;
otherwise
do;
call sqlErr(sourceLine(), 'selectPidClientInto');
end;
end; /* select sqlCode */
return ('1'b);
end selectPidClientIxOnly;
/*
sqlConnect__________________________________________________________*/
%include yxrrsaf;
sqlConnect:proc();
dcl ssid char(04) init('DBOF');
dcl plan char(08) init('QZTEST');
if yxrrsaf('CONNECT',ssid,plan) ^= 0 then
put('QZPLB'
,'Error in YXRRSAF Call'
,'SSID - '||ssid
,'PLAN - '||plan);
end sqlConnect;
/*
commit_______________________________________________________________*/
sql_commit: proc();
if noCommit then
return;
if yxrrsaf('COMMIT') ^= 0 then
put('QZPLB'
,'Error in YXRRSAF Commit Call');
cCommit = cCommit + 1;
end sql_commit;
sql_rollback: proc();
if yxrrsaf('ROLLBACK') ^= 0 then
put('QZPLB'
,'Error in YXRRSAF ROLLBACK Call');
end sql_rollback;
DCL DSNTIAR ENTRY EXTERNAL OPTIONS(ASM INTER RETCODE);
sqlMsg: proc ();
DCL MSGWIDTH FIXED BIN(31) INIT(72);
DCL MSGBLEN FIXED BIN(15) INIT(20); /* MAX # SQL MESSAGES */
DCL i FIXED BIN(31) INIT(0);
DCL 01 MESSAGE /* MESSAGE RETURN BUFFER */
, 02 MESSAGEL FIXED BIN(15) INIT(1440) /* BUFFER LENGTH */
, 02 MESSAGET(MSGBLEN) CHAR(msgWidth) INIT((*)' ') /* TEXT */
;
/* NOW PRINT OUT SQL STATEMENT RESULTS VIA DSNTIAR */
CALL DSNTIAR(SQLCA,MESSAGE,MSGWIDTH);
IF PLIRETV ^= 0 THEN DO; /* IF THE RETURN CODE ISN'T ZERO@08*/
/* ISSUE AN ERROR MESSAGE @08*/
PUT EDIT (' RETURN CODE ', PLIRETV, /* @08*/
' FROM MESSAGE ROUTINE DSNTIAR.') /* @08*/
(COL(1), A(13), F(8), A(30)); /* ISSUE THE MESSAGE @08*/
END; /* END ISSUE AN ERROR MESSAGE @08*/
DO I = 1 TO MSGBLEN /* @08*/
WHILE (MESSAGET(I) ^= ''); /* @08*/
PUT EDIT ( MESSAGET(I) ) (COL(1), A(msgWIdth)); /* @08*/
END; /* @08*/
end SqlMsg;
sqlErr: proc (lNo, txt);
DCL lNo FIXED BIN(31);
dcl txt char(500) varying;
put ('error at ' || trim(edit(lNo, 'ZZZZZZZZZ9'))
|| ': ' || txt) skip;
call sqlMsg;
call sql_rollback;
put ('error signal error') skip;
signal error;
end sqlErr;
1/**-----------------------------------------------------------------**/
/** **/
/** 6.0 M a i n - L o g i c **/
/** **/
/**-----------------------------------------------------------------**/
put ('start qzCdPut parm=' || $parm || ',le', length($parm)) skip;
IF LENGTH($parm) >= 1 then
fun = substr($parm, 1, 1);
else
fun = 'A';
IF LENGTH($parm) >= 2 then
IF substr($parm, 2, 1) = '0' then
noSql = '1'b ;
put edit(' fun=', fun, ' noSql=', noSql)
(a(8), a(1), a(7), b(1)) skip;
call sqlConnect ;
if fun = 'A' then do;
put edit ('52max ', tcd152KeysMax) (a(20), f(5)) skip;
do tcd152KeysIx=1 to tcd152KeysRep;
tcd152KeysJx = tcd152KeysJx + tcd152KeysStep;
if (tcd152KeysJx > tcd152KeysMax) then
tcd152KeysJx = tcd152KeysJx - tcd152KeysMax;
put edit (tcd152KeysIx, ' jx=', tcd152KeysJx
, ' s=', tcd152key(tcd152KeysJx).SERVICEID
, ' i=', tcd152key(tcd152KeysJx).INTERFACENAME)
(f(6), a(4), f(4), a(3), a(20), a(3), a(30)) skip;
end;
end;
else if fun = 'E' then do;
put edit ('52max ', tcd152KeysMax) (a(20), f(5)) skip;
do tcd152KeysIx=1 to tcd152KeysRep;
tcd152KeysJx = tcd152KeysJx + tcd152KeysStep;
if (tcd152KeysJx > tcd152KeysMax) then
tcd152KeysJx = tcd152KeysJx - tcd152KeysMax;
CDPUT3_interfaceName = tcd152key(tcd152KeysJx).INTERFACENAME;
CDPUT3_serviceId = tcd152key(tcd152KeysJx).SERVICEID;
if ( getDataFromTCD152_ok(tcd152KeysPtr) ) then ;
call sql_commit;
end;
put edit(c152Found, ' tcd152 open/fetch/close')
(f(9), a(50)) skip;
end;
else if fun = 'F' then do;
put edit ('52max ', tcd152KeysMax) (a(20), f(5)) skip;
do tcd152KeysIx=1 to tcd152KeysRep;
tcd152KeysJx = tcd152KeysJx + tcd152KeysStep;
if (tcd152KeysJx > tcd152KeysMax) then
tcd152KeysJx = tcd152KeysJx - tcd152KeysMax;
CDPUT3_interfaceName = tcd152key(tcd152KeysJx).INTERFACENAME;
CDPUT3_serviceId = tcd152key(tcd152KeysJx).SERVICEID;
call selectTCD152Into ;
call sql_commit;
end;
put edit(c152selInto, ' tcd152 select Into')
(f(9), a(50)) skip;
end;
else if fun = 'P' then do;
put edit ('52max ', tcd152KeysMax) (a(20), f(5)) skip;
do tcd152KeysIx=1 to tcd152KeysRep;
tcd152KeysJx = tcd152KeysJx + tcd152KeysStep;
if (tcd152KeysJx > tcd152KeysMax) then
tcd152KeysJx = tcd152KeysJx - tcd152KeysMax;
ttgpcif.i.userPid = tcd152key(tcd152KeysJx).INTERFACENAME;
ttgpcif.i.clientId = tcd152key(tcd152KeysJx).SERVICEID;
if ^getPidClientIdFromTCD150_ok (addr(ttgpcif)) then
cPidClientErr = cPidClientErr + 1;
else if ttgpcif.o.hasFound then
cPidClientFound = cPidClientFound + 1;
else
cPidClientNoFo = cPidClientNoFo + 1;
call sql_commit;
end;
put edit(cPidClientNoFo , ' pidClient notFound')
(f(9), a(50)) skip;
put edit(cPidClientErr , ' pidClient error')
(f(9), a(50)) skip;
put edit(cPidClientFound, ' pidClient found')
(f(9), a(50)) skip;
put edit(cPidClientOp, ' pidClient open')
(f(9), a(50)) skip;
put edit(cPidClientF1, ' pidClient fetch 1')
(f(9), a(50)) skip;
put edit(cPidClientF2, ' pidClient fetch 2')
(f(9), a(50)) skip;
put edit(cPidClientCl, ' pidClient close')
(f(9), a(50)) skip;
end;
else if fun = 'Q' then do;
put edit ('52max ', tcd152KeysMax) (a(20), f(5)) skip;
do tcd152KeysIx=1 to tcd152KeysRep;
tcd152KeysJx = tcd152KeysJx + tcd152KeysStep;
if (tcd152KeysJx > tcd152KeysMax) then
tcd152KeysJx = tcd152KeysJx - tcd152KeysMax;
ttgpcif.i.userPid = tcd152key(tcd152KeysJx).INTERFACENAME;
ttgpcif.i.clientId = tcd152key(tcd152KeysJx).SERVICEID;
if ^ selectPidClientInto (addr(ttgpcif)) then
cPidClientErr = cPidClientErr + 1;
else if ttgpcif.o.hasFound then
cPidClientFound = cPidClientFound + 1;
else
cPidClientNoFo = cPidClientNoFo + 1;
call sql_commit;
end;
put edit(cPidClientNoFo , ' pidClient notFound')
(f(9), a(50)) skip;
put edit(cPidClientErr , ' pidClient error')
(f(9), a(50)) skip;
put edit(cPidClientFound, ' pidClient found')
(f(9), a(50)) skip;
put edit(cPidClientInto, ' pidClient select into')
(f(9), a(50)) skip;
end;
else if fun = 'R' then do;
put edit ('52max ', tcd152KeysMax) (a(20), f(5)) skip;
do tcd152KeysIx=1 to tcd152KeysRep;
tcd152KeysJx = tcd152KeysJx + tcd152KeysStep;
if (tcd152KeysJx > tcd152KeysMax) then
tcd152KeysJx = tcd152KeysJx - tcd152KeysMax;
ttgpcif.i.userPid = tcd152key(tcd152KeysJx).INTERFACENAME;
ttgpcif.i.clientId = tcd152key(tcd152KeysJx).SERVICEID;
if ^ selectPidClientIxOnly (addr(ttgpcif)) then
cPidClientErr = cPidClientErr + 1;
else if ttgpcif.o.hasFound then
cPidClientFound = cPidClientFound + 1;
else
cPidClientNoFo = cPidClientNoFo + 1;
call sql_commit;
end;
put edit(cPidClientNoFo , ' pidClient ixOnly notFound')
(f(9), a(50)) skip;
put edit(cPidClientErr , ' pidClient error')
(f(9), a(50)) skip;
put edit(cPidClientFound, ' pidClient found')
(f(9), a(50)) skip;
put edit(cPidClientInto, ' pidClient select into')
(f(9), a(50)) skip;
end;
else do;
put ('no Fun ' || fun) skip;
end;
put edit(cCommit , ' commits')
(f(9), a(50)) skip;
put ('end qzCdPut noSql=', noSql) skip;
if ( 1 = 0) then do;
if ( yCDPUT3k.in.CDPUT3_traceLevel > 1 ) then
aux.isPutOn = '1'b ;
else
aux.isPutOn = '0'b ;
if isHeading_ok ( 'YCDPUT3 '
, in.CDPUT3_pid ) then
do;
select ( CDPUT3_processType ) ;
when ( '1' ) /* Top-Module */
do;
if processType_1() then ;
end;
when ( '2' ) /* Sub-Module */
do;
if processType_2() then ;
end;
when ( '3' ) /* Top-Module duration schreiben */
do;
if processType_3() then ;
end;
otherwise
do;
/* kann leer sein. */
end;
end; /* select */
end;
call Footing ( 'YCDPUT3' ) ; /* pgmName */
end;
end QZCDPUT;
}¢--- A540769.WK.PLB(QZCDPUT3) cre=2014-06-02 mod=2014-06-04-13.51.18 A540769 ---
*process RULES(LAXSEMI); /* suppress semicolon-warning */
*process RULES(BYNAME) ; /* allow "by name" */
*process RULES(NOLAXIF); /* suppress conversion in boolean expression */
/********************************************************************/
/* */
/* Letzte Source-Änderung: 02. Oct. 2013 14:00 A959103 */
/* */
/********************************************************************/
/* */
/* Autor : Markus Niederhauser */
/* Datum : 18.01.2001 */
/* */
/*********************************************************************/
yCDPUT3: Proc($PyCDPUT3) options(fetchable);
/*********************************************************************/
/* Change-Log MDL095 2008-02-14 */
/*********************************************************************/
/* */
/*-------------------------------------------------------------------*/
/* Release Req./Ticket PID Text */
/*-------------------------------------------------------------------*/
/* Z1311080 PR014104JI-29 A959103 add CD57 getCifsLong_4.0 */
/* Z1308090 PRQ1348 A959103 add CA59 & CA60 */
/* PRQ1348 A727897 add RM38 */
/*-------------------------------------------------------------------*/
/* Z1305100 PRQ1262 A393014 add RM36 + RM37 */
/*-------------------------------------------------------------------*/
/* Z1302080 PRQ1123 A393014 Maintaining clientIds */
/* */
/* PRQ1123 mn@20121115 Markus Niederhauser */
/* add CD56 */
/* CD56: IF getCifsLong_3.0 */
/* PRQ1123 ad@20121220 Andreas Dahinden */
/* CA14, CI74: YYAUPRE changed to YCDAURA */
/*-------------------------------------------------------------------*/
/* Z1211090 PRQ1026 A393014 Maintaining clientIds */
/* */
/* PRQ1026 mn@20120913 Markus Niederhauser */
/* if clientId='' then ignore comparison */
/* PRQ1026 mn@20120718 Markus Niederhauser */
/* CA37, CA38, CA39 & CA40 add - YCDGETB */
/* - YCDOEFU */
/*-------------------------------------------------------------------*/
/* Z1208100 PRQ882 A393014 CA37, CA38 & CA39 add YCDGETB */
/* */
/* PRQ882 mn@20120608 Markus Niederhauser */
/* CA37, CA38 & CA39 add YCDGETB */
/*-------------------------------------------------------------------*/
/* Z1205110 PRQ757 A393014 CI70 maxAllowedInputSeq= 600¦ */
/* Z1205110 PRQ771 A959103 CD55 IF getCifsLong_2.0 */
/* Z1205110 PRQ770 A959103 CA14 IF searchCif_2.0 */
/* */
/* PRQ628 mn@20111024 Markus Niederhauser */
/* CI70: maxAllowedInputSeq= 600¦ */
/* PRQ771 ad@20120229 Andreas Dahinden */
/* CD55: IF getCifsLong_2.0 */
/* PRQ770 ad@20120229 Andreas Dahinden */
/* CA14: IF searchCif_2.0 */
/*-------------------------------------------------------------------*/
/* Z1202100 PRQ628 A393014 crm4rmicMaxNodes */
/* */
/* PRQ628 mn@20111024 Markus Niederhauser */
/* crm4rmicMaxNodes -> RM68 + RM50 */
/*-------------------------------------------------------------------*/
/* Z1109090 PRQ381 A393014 CA90+CA93:Maske */
/* */
/* PRQ381 mn@20110719 Markus Niederhauser */
/* CA90+CA93:Maske forApplUse_01 */
/*-------------------------------------------------------------------*/
/*--------------+--------+-------------------------------------------*/
/* CcYy-mm-dd ¦ OFR ¦ Name, Instradation */
/* NME@CcYyMmDd ¦ xxx.0 ¦ - Correction A */
/* NM@CcYyMmDd ¦ yyy.0 ¦ - Correction B */
/*--------------+--------+-------------------------------------------*/
/* 2010-08-13 ¦ ¦ Niederhauser Markus, KCAB 323 */
/* mn@20100510 ¦ 479.x ¦ - add the fields */
/* ¦ ¦ - currentDate */
/* ¦ ¦ - dayOfWeek */
/*--------------+--------+-------------------------------------------*/
/* 2010-05-14 ¦ ¦ Niederhauser Markus, KCAB 323 */
/* mn@20100310 ¦ 479.x ¦ - CI70 */
/* mn@20100302 ¦ 479.x ¦ - CD71 */
/* mn@20100107 ¦ 479.x ¦ - CI76 */
/* mn@20100107 ¦ 479.x ¦ - CD87 */
/*--------------+--------+-------------------------------------------*/
/* 2010-02-12 ¦ ¦ Niederhauser Markus, KCAB 323 */
/* mn@20100105 ¦ 479.x ¦ - CI88 */
/* mn@20091218 ¦ 479.x ¦ - RM98: Mail=Y */
/* mn@20091216 ¦ 479.x ¦ - RM84 */
/* mn@20091208 ¦ 479.x ¦ - CI90 + CI91 */
/* mn@20091111 ¦ 479.x ¦ - YDA0720 */
/* ¦ 479.x ¦ - CA51 + CA52 + CA53 + CA54 */
/*--------------+--------+-------------------------------------------*/
/* 2009-11-13 ¦ ¦ Niederhauser Markus, KCAB 323 */
/* mn@20090824 ¦ 479.x ¦ - YCD083A, C & D */
/*--------------+--------+-------------------------------------------*/
/* 2009-08-14 ¦ ¦ Niederhauser Markus, KCAB 323 */
/* mn@20090603 ¦ 479.x ¦ - YCD083B */
/*--------------+--------+-------------------------------------------*/
/* 2009-02-13 ¦ ¦ Shanthi Chinnadurai, KCAB 323 */
/* cs@20081106 ¦ 312.5 ¦ - RM0980R trace option */
/* mn@20081110 ¦ 312.5 ¦ - YCD080B */
/*--------------+--------+-------------------------------------------*/
/* 2008-05-09 ¦ ¦ Markus Niederhauser, KSFI 411 */
/* mn@20080310 ¦ 191.6 ¦ - Eliminate EPLI-Warnings */
/*--------------+--------+-------------------------------------------*/
/* 2007-11-09 ¦ ¦ Markus Niederhauser, KSFI 411 */
/* mn@20070705 ¦ 988.0 ¦ - explementation of @compvers */
/* gl20070813 ¦ 988.0 ¦ - Compvers included */
/* mn@20070913 ¦ 988.0 ¦ - explementation of ceetdli */
/*--------------+----------------------------------------------------*/
/* 2007-08-10 ¦ Markus Niederhauser, KSFA 521 */
/* mn@20070424 ¦ - TCD900A1 -> TCD153A1 */
/*--------------+----------------------------------------------------*/
/* 2007-05-11 ¦ Markus Niederhauser, KSFA 521 */
/* mn@20070323 ¦ - YRM065B-Process */
/*--------------+----------------------------------------------------*/
/* 2007-03-09 ¦ Markus Niederhauser, KSFA 521 */
/* mn@20061031 ¦ - TCD150 -> TCD900 */
/*--------------+----------------------------------------------------*/
/* 2006-03-10 ¦ Markus Niederhauser, KBIE 21 */
/* mn@20051221 ¦ - Init anpassen für _C__77_ */
/*--------------+----------------------------------------------------*/
/* */
/* 11.11.2005 Markus Niederhauser / KBIE 21 /* Start mn20050830 */
/* - CDADMIN erweitern mit Release-Nummer */
/* */
/* 12.08.2005 Markus Niederhauser / KBIE 21 /* Start tm 050406 */
/* - Region-Name in TCD150 einfügen */
/* */
/* 17.09.2004 Markus Niederhauser KASK 21 /* Start mn 040826 */
/* - Plausis überarbeiten */
/* - PID='NOSECUR ' zulassen */
/* */
/* 04.02.2002 Markus Niederhauser KASK 21 /* mn 040202 */
/* Erweiterung mit Array von PIDs */
/* */
/* */
/*********************************************************************/
/*********************************************************************/
/** **/
/*********************************************************************/
/** **/
/** A. Zusammenhang **/
/** =============== **/
/** Es gibt die Tabelle TCD150. Auf dieser Tabelle kann von Hand **/
/** spezifiziert werden, ob eine gewisse Transaktion in die **/
/** Region putten soll oder nicht. **/
/** **/
/** **/
/** **/
/** B. Zweck **/
/** ======== **/
/** - Das aufrufende Programm übergibt dem yCDPUT3 den Programm- **/
/** Namen (CD150001) und die Version (CD150003). **/
/** - yCDPUT3 sucht die vorhandene Row, die den Schlüssel-feldern **/
/** CD150001 bis CD150004 entspricht. **/
/** - Gibt es keine passende Row, wird eine Row in die Tabelle **/
/** TCD150 eingefügt mit traceLevel=0 und keine PIDs. **/
/** - Die gefundene/eingefügte Row wird an das aufrufende **/
/** Programm zurückgegeben. Und zwar den Trace-Level (CD150011), **/
/** alle PIDs (CD150012) plus die Bit-Batterie von Put-Flags **/
/** **/
/** **/
/** **/
/** **/
/** C. Inhaltsverzeichnis **/
/** ===================== **/
/** **/
/** 1.0 D e k l a r a t i o n e n **/
/** 1.1 Kommunikationsstruktur **/
/** 1.2 Files **/
/** 1.3 Datuemer **/
/** 1.4 DB2 Applikatorisch **/
/** 1.5 DB2 Infra **/
/** 1.6 Strukturen **/
/** 1.7 Uebrige Deklarationen **/
/** **/
/** 2.0 O n - U n i t s **/
/** **/
/** 3.0 I n i t i a l i s i e r u n g e n **/
/** 3.1 Datuemer **/
/** 3.2 Outputparameter **/
/** **/
/** 4.0 M a i n - L o g i c **/
/** **/
/** 5.0 P r o z e d u r e n **/
/** 5.1 plausi_input_fields_ok **/
/** 5.3 PutProc **/
/** **/
/** **/
/*********************************************************************/
1/**-----------------------------------------------------------------**/
/** **/
/** 1.0 D e k l a r a t i o n e n **/
/** **/
/**-----------------------------------------------------------------**/
-/**-----------------------------------------------------------------**/
/** 1.01 Kommunikationsstruktur **/
/**-----------------------------------------------------------------**/
dcl $PyCDPUT3 ptr,
PyCDPUT3 ptr;
PyCDPUT3 = $PyCDPUT3;
dcl 1 yCDPUT3k based(PyCDPUT3),
%include yCDPUT3K ;;
-/**-----------------------------------------------------------------**/
/** 1.02 Files **/
/**-----------------------------------------------------------------**/
dcl Sysprint file print output ;
-/**-----------------------------------------------------------------**/
/** 1.03 Datuemer **/
/**-----------------------------------------------------------------**/
%include YcdTS;
dcl TimeStamp char(26) init ('');
-/**-----------------------------------------------------------------**/
/** 1.03 IMS **/
/**-----------------------------------------------------------------**/
/*
dcl 1 tp based ( CDPUT3_ptrLtm ) ,
%include TPPCBW ; ;
*/
%include PLITDLI; ;
dcl c2 bin fixed(31) static init(2);
dcl c3 bin fixed(31) static init(3);
dcl isrt char(04) static init('ISRT');
dcl chng char(04) static init('CHNG');
dcl purg char(04) static init('PURG');
dcl ii bin fixed(31);
dcl len bin fixed(31); /* Länge */
/*
dcl totl bin fixed(31); /* Total Länge / Rest Länge*/
/*
dcl anzm bin fixed(31); /* Anzahl Messages */
dcl dtoutl bin fixed(31); /* Daten-Output-Länge */
dcl poutmsg ptr; /* Ptr für Outmsg */
dcl ltm ptr;
dcl pgm ptr;
%include nsotppcb;
dcl 1 outmsg ,
%include nsoppm;
2 isPutOn bit (1)aligned init('0'b), /* mn@20100204 */
2 processType char(1) ,
2 padd_01 char(2) ,
2 dtout char(5900) ; /* Daten-Output thb241003*/
poutmsg = addr(outmsg);
-/**-----------------------------------------------------------------**/
/** 1.2 Program-specific MDL049 2008-03-19 **/
/**-----------------------------------------------------------------**/
%DCL COMPILETIME BUILTIN;
%DCL COMP_TIME CHAR;
%COMP_TIME = '''compilation-time: ' || COMPILETIME || '''';
%DCL COMP_VERS CHAR;
%comp_VERS = '''EPLI-compiler : EPLI' || '''' ;
-/**-----------------------------------------------------------------**/
/** 1.05 DB2 TCD150 **/
/**-----------------------------------------------------------------**/
/* Table */
exec SQL
declare TCD150A1 table
%include TCD150D;;
dcl 1 TCD150,
%include TCD150;;
/* Cursor */
exec SQL
declare C_yCDPUT3 cursor for
select %include TCD150F;
from TCD150A1
where CD150001 = :CDPUT3_metaId
and CD150002 = 'YCD'
and CD150003 = 'PUT'
and CD150005 < :TimeStamp
and CD150006 >= :TimeStamp
order by CD150003 ;
/* Cursor */
exec SQL
declare C_region cursor for
select %include TCD150F;
from TCD150A1
where CD150001 = :CDPUT3_metaId
and CD150002 = 'REG'
and CD150003 = 'ION'
and CD150005 < :TimeStamp
and CD150006 >= :TimeStamp
order by CD150003 ;
/* Cursor */
exec SQL
declare C_tracePidClientId cursor for
select %include TCD150F;
from TCD150A1
where CD150001 = 'TRACE'
and
( ( CD150002 = 'CLIE'
and CD150003 = 'NTID'
)
or
(
CD150002 = 'PID '
and CD150003 = ' '
)
)
and CD150005 < :TimeStamp
and CD150006 >= :TimeStamp
;
-/**-----------------------------------------------------------------**/
/** 1.05 DB2 TCD152 **/
/**-----------------------------------------------------------------**/
/* Table */
exec SQL
declare TCD152A1 table
%include TCD152D;;
dcl 1 TCD152 ,
%include TCD152; ,
2 currentTs char(26) ,
2 dayOfWeek bin fixed(31) ;
/* Cursor */
exec SQL
declare C_tcd152 cursor for
select %include TCD152F;
, current timestamp
, dayOfWeek( current date )
from TCD152A1
where serviceId = :CDPUT3_serviceId
and interfaceName = :CDPUT3_interfaceName
;
-/**-----------------------------------------------------------------**/
/** 1.06 DB2 tcd153 **/
/**-----------------------------------------------------------------**/
/* Table */
exec SQL
declare tcd153A1 table
%include tcd153D;;
dcl tcd153_area char(1000) init('') ;
dcl 1 tcd153 based
( addr(tcd153_area) ) ,
%include tcd153; ;
-/**-----------------------------------------------------------------**/
/** 1.06 DB2 tcd900 **/
/**-----------------------------------------------------------------**/
/* Table */
exec SQL
declare tcd900A1 table
%include tcd900D;;
dcl tcd900_area char(1000) init('') ;
dcl 1 tcd900 based
( addr(tcd900_area) ) ,
%include tcd900; ;
1/**-----------------------------------------------------------------**/
/** 1.5 ceetdli **/
/**-----------------------------------------------------------------**/
/*
%include ceeibmaw ;
*/
/*
dcl ceetdli entry; mn@20070913
*/
1/**-----------------------------------------------------------------**/
/** 1.5 CDADMIN **/
/**-----------------------------------------------------------------**/
dcl 1 cdadmin based( CDPUT3_ptrCdadmin ) ,
%include cdadmins; ;
1/**-----------------------------------------------------------------**/
/** 1.5 DB2 Infrastruktur **/
/**-----------------------------------------------------------------**/
dcl 1 SQLCA based(CDPUT3_SQLCA),
%include SQLSTATE;
-/**-----------------------------------------------------------------**/
/** 1.6 Strukturen **/
/**-----------------------------------------------------------------**/
dcl
1 aux , /* auxiliary */
3 isPutOn bit(1) aligned init('0'b) ,
3 putFlag(100) char(1) init((100)('')),
3 C_tcd152_open bit(1) aligned init('0'b) ,
3 C_yCDPUT3_open bit(1) aligned init('0'b) ,
3 c_region_open bit(1) aligned init('0'b) ,
3 c_tracePidClientId_open bit(1) aligned init('0'b) ,
3 ts char(26) init( '' ),
3 t bin fixed(31,0) init( 0 ) , /* tabulator */
3 p_9 pic'9' init( 0 ) ;
-/**-----------------------------------------------------------------**/
/** 1.7 Uebrige Deklarationen **/
/**-----------------------------------------------------------------**/
dcl ( addr
, cstg
, datetime
, hbound
, high
, length
, max
, min
, mod
, null
, ptradd
, string
, substr
, sysnull
, translate
, verify ) builtin;
1/**-----------------------------------------------------------------**/
/** **/
/** 2.0 O n - U n i t s **/
/** **/
/**-----------------------------------------------------------------**/
1/**-----------------------------------------------------------------**/
/** **/
/** 3.0 I n i t i a l i s i e r u n g e n **/
/** **/
/**-----------------------------------------------------------------**/
-/**-----------------------------------------------------------------**/
/** 3.1 Datuemer **/
/**-----------------------------------------------------------------**/
TimeStamp = YcdTS('E');
1/**-----------------------------------------------------------------**/
/** **/
/** 5.0 P r o z e d u r e n **/
/** **/
/**-----------------------------------------------------------------**/
/**-----------------------------------------------------------------**/
/** 5.1 plausi_input_fields_ok **/
/**-----------------------------------------------------------------**/
plausi_input_fields_ok:
Proc
returns ( bit(1) aligned );
dcl @hasFehler bit(1) aligned init('0'b);
YCDM616
do; /* Diese Prüfung muss vor dem ersten Put passieren */ YCDM616
DCL CDPUT3_whichSysprint based(addr(CDPUT3_sysprint)) char(4) ; YCDM61
if (CDPUT3_whichSysprint = '') then YCDPUT
do;
aux.isPutOn = '1'b;
CDPUT3_sysprint = sysprint;
call putM('*' ,70);
call putR('** CDPUT3_sysprint nicht abgefüllt' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
end; /* Diese Prüfung muss vor dem ersten Put passieren */ YCDM616
if ( $PyCDPUT3 = null()) then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** $pyCDPUT3 ist null' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
if aux.isPutOn then
do;
call putFrame('start'
,'plausi_input_fields_ok' ,70);
call putR('** eye . . . . . : ' ||
CDPUT3_eye ,70);
call putR('** release . . . : ' ||
CDPUT3_release ,70);
call putR('** processType . : ' ||
in.CDPUT3_processType ,70);
call putR('** interfaceName : ' ||
in.CDPUT3_interfaceName ,70);
call putR('** operationName : ' ||
in.CDPUT3_operationName ,70);
call putR('** serviceId . . : ' ||
in.CDPUT3_serviceId ,70);
call putR('** pgmName . . . : ' ||
in.CDPUT3_pgmName ,70);
call putR('** metaId . . . : ' ||
in.CDPUT3_metaId ,70);
call putR('** bereich . . . : ' ||
in.CDPUT3_bereich ,70);
call putR('** pid . . . . . : ' ||
in.CDPUT3_pid ,70);
call putR('** mainPgmName . : ' ||
in.CDPUT3_mainPgmName ,70);
call putR('** traceLevel . : ' ||
bin31_to_char(in.CDPUT3_traceLevel) ,70);
/*
call putR('** comp . . . . : ' ||
in.CDPUT3_comp ,70);
*/
end;
if (CDPUT3_eye ^= '#@YCDPUT3@#') then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDPUT3_eye ist nicht korrekt' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putR('** Eye : ' || CDPUT3_eye ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
if ( CDPUT3_release = 'Rel.0004' ) then
do;
end;
else
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDPUT3_release ist falsch' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putR('** Release : ' || CDPUT3_release ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
/*
if (in.CDPUT3_processType = '1') then /* Top-Module */
/*
do;
*/
if (in.CDPUT3_ptrCdadmin = null()) then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDPUT3_ptrCdadmin ist null' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
else
do;
if (cdadmin_01 ^= '#@CDADMIN@#') then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDADMIN_01 ist nicht korrekt' ,70);
call putR('** CDADMIN_01 : ' || CDADMIN_01 ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
if (cdadmin_01a ^= 'Rel.0001') then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDADMIN_01a ist falsch' ,70);
call putR('** CDADMIN_01a : ' || cdadmin_01a ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
end;
/*
end;
*/
if (CDPUT3_SQLCA = null()) then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDPUT3_sqlca ist null' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
if (in.CDPUT3_processType = '1') then /* Top-Module */
do;
if (CDPUT3_metaId = '') then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDPUT3_metaId ist blank' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
end;
if (in.CDPUT3_processType = '1') then /* Top-Module */
do;
if (in.CDPUT3_pid = '' |
in.CDPUT3_pid = 'specify') then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDPUT3_pid muss abgefüllt werden' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
end;
if (CDPUT3_mainPgmName = '' |
CDPUT3_mainPgmName = 'specify') then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDPUT3_mainPgmName muss abgefüllt werden' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
if (in.CDPUT3_processType = '1') then /* Top-Module */
do;
if ( in.CDPUT3_pid ^= 'nosecur '
& in.CDPUT3_pid ^= 'NOSECUR '
& in.CDPUT3_pid ^= 'specify '
& in.CDPUT3_pid ^= '' ) then
do;
if ((verify(substr(in.CDPUT3_pid ,1,1),
'ABCDEFGHIJKLMNOPQRSTUVWXYZ') ^= 0 |
verify(substr(in.CDPUT3_pid,2,7),'0123456789 ') ^= 0)) then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** Service . : '|| CDPUT3_metaId ,70);
call putR('** CDPUT3_pid : '||in.CDPUT3_pid ,70);
call putR('** CDPUT3_pid ist ungueltig' ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
end;
end;
if aux.isPutOn then
do;
call putFrame('end ','plausi_input_fields_ok' ,70);
end;
/* Analse */
/* ------ */
if @hasFehler then
do;
CDPUT3_RC = 10;
return('0'b) ;
end;
else
do;
CDPUT3_RC = 0 ;
return('1'b) ;
end;
end plausi_input_fields_ok;
1/**-----------------------------------------------------------------**/
/** 5.22 Bin31_To_Char **/
/**-----------------------------------------------------------------**/
Bin31_To_Char: proc ( @bin31 )
returns ( char(5)var );
dcl @bin31 bin fixed(31) ;
dcl @charVar char(5) var init('') ;
select ;
when ( @bin31 < 10
& @bin31 > -10 )
do;
@charVar = bin31_to_char1( @bin31 );
end;
when ( @bin31 < 100
& @bin31 > -100 )
do;
@charVar = bin31_to_char2( @bin31 );
end;
when ( @bin31 < 1000
& @bin31 > -1000 )
do;
@charVar = bin31_to_char3( @bin31 );
end;
when ( @bin31 < 10000
& @bin31 > -10000 )
do;
@charVar = bin31_to_char4( @bin31 );
end;
otherwise
do;
@charVar = bin31_to_char5( @bin31 );
end;
end; /* select ( @bin31 ) */
if @bin31 < 0 then
do;
@charVar = '-' || @charVar ;
end;
return ( @charVar ) ;
end Bin31_To_Char ;
/*
Bin31_To_Char1 mdl MDL076
Bin31_To_Char2 mdl MDL004
Bin31_To_Char3 mdl MDL003
Bin31_To_Char4 mdl MDL005
Bin31_To_Char5 mdl MDL074
*/
1/**-----------------------------------------------------------------**/
/** 5.22 Bin31_To_Char1 **/
/**-----------------------------------------------------------------**/
Bin31_To_Char1: proc ( @bin31 )
returns ( char(1) );
dcl @bin31 bin fixed(31) ;
dcl @p9 pic'9' init( 0) ;
dcl @char1 based(addr(@p9)) char ( 1 );
@p9 = @bin31 ;
return ( @char1 ) ;
end Bin31_To_Char1 ;
1/**-----------------------------------------------------------------**/
/** 5.22 Bin31_To_Char2 **/
/**-----------------------------------------------------------------**/
Bin31_To_Char2: proc ( @bin31 )
returns ( char(2) );
dcl @bin31 bin fixed(31) ;
dcl @pz9 pic'z9' init( 0) ;
dcl @char2 based(addr(@pz9)) char ( 2 );
@pZ9 = @bin31 ;
return ( @char2 ) ;
end Bin31_To_Char2 ;
1/**-----------------------------------------------------------------**/
/** 5.21 Bin31_To_Char3 **/
/**-----------------------------------------------------------------**/
Bin31_To_Char3: proc ( @bin31 )
returns ( char(3) );
dcl @bin31 bin fixed(31) ;
dcl @pzz9 pic'zz9' init( 0) ;
dcl @char3 based(addr(@pzz9)) char ( 3 );
@pZZ9 = @bin31 ;
return ( @char3 ) ;
end Bin31_To_Char3 ;
1/**-----------------------------------------------------------------**/
/** 5.23 Bin31_To_Char4 **/
/**-----------------------------------------------------------------**/
Bin31_To_Char4: proc ( @bin31 )
returns ( char(4) );
dcl @bin31 bin fixed(31) ;
dcl @pzzz9 pic'---9' init( 0) ;
dcl @char4 based(addr(@pzzz9)) char ( 4 );
@pZZZ9 = @bin31 ;
return ( @char4 ) ;
end; /* Bin31_To_Char4 */
1/**-----------------------------------------------------------------**/
/** 5.23 Bin31_To_Char5 **/
/**-----------------------------------------------------------------**/
Bin31_To_Char5: proc ( @bin31 )
returns ( char(5) );
dcl @bin31 bin fixed(31) ;
dcl @pzzzz9 pic'zzzz9' init( 0) ;
dcl @char5 based(addr(@pzzzz9)) char ( 5 );
@pZZZZ9 = @bin31 ;
return ( @char5 ) ;
end Bin31_To_Char5 ;
1/**-----------------------------------------------------------------**/
/** 5.2 Fetch_C_tcd152_ok **/
/**-----------------------------------------------------------------**/
Fetch_C_tcd152_ok:
Proc ( $p_fcyo )
returns ( bit(1) aligned );
dcl $p_fcyo ptr ;
dcl 1 @fcyo based ($p_fcyo) ,
3 i ,
5 dummy char( 0) init('') ,
3 o ,
5 hasFound bit ( 1) aligned init('') ,
5 padd_01 char( 3) init('') ,
5 end char( 0) init('') ;
dcl @isOk bit(1)aligned init('1'b);
if aux.isPutOn then
do;
call putFrame('start','Fetch_C_tcd152_ok' ,70);
end;
/*
dcl 1 @tcd152 ,
%include tcd152 ;;
*/
/*****************/
/** Fetch Row **/
/*****************/
do;
exec SQL
fetch C_tcd152
into :TCD152 ;
select ( sqlca.sqlcode ) ;
when ( 0 )
do;
@fcyo.o.hasFound = '1'b;
end;
when ( 100 )
do;
@fcyo.o.hasFound = '0'b;
end;
otherwise
do;
aux.isPutOn = '1'b ;
@isOk = '0'b ;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'Fetch C_tcd152'
, '1010' /* traceId */
) then @isOk = '0'b ;
end;
end;
end;
if aux.isPutOn then
do;
call putR ('** @hasFound : ' ||
@fcyo.o.hasFound ,70);
call putR ('** @isOk . . : ' ||
@isOk ,70);
call putFrame('end ','Fetch_C_tcd152_ok' ,70);
end;
return( @isOk ) ;
end Fetch_C_tcd152_ok;
1/**-----------------------------------------------------------------**/
/** 5.2 Fetch_C_tracePidClientId_ok **/
/**-----------------------------------------------------------------**/
Fetch_C_tracePidClientId_ok:
Proc ( $p_ftpc )
returns ( bit(1) aligned );
dcl $p_ftpc ptr ;
dcl 1 @ftpc based ($p_ftpc) ,
3 i ,
5 userPid char( 8) ,
5 clientId char(10) ,
5 padd_01 char( 2) ,
3 o ,
5 hasFound bit ( 1) aligned ,
5 padd_01 char( 3) ,
5 uSwitch bin fixed(31) ,
/* 1 : userPid found */
/* 2 : clientId found */
5 userPid char( 8) ,
5 clientId char(10) ,
5 padd_02 char( 2) ,
3 endOfStruc char( 0) ;
dcl @isOk bit(1)aligned init('1'b);
if aux.isPutOn then
do;
call putFrame('start','Fetch_C_tracePidClientId_ok' ,70);
end;
@ftpc.o.hasFound = '0'b;
/*****************/
/** Fetch Row **/
/*****************/
exec SQL
fetch C_tracePidClientId
into :TCD150 ;
do while ( sqlca.sqlcode = 0
& ^@ftpc.o.hasFound
) ;
select ( sqlca.sqlcode ) ;
when ( 0 )
do;
select;
when ( @ftpc.i.userPid = substr(tcd150.cd150011,1,8) )
do;
@ftpc.o.hasFound = '1'b ;
@ftpc.o.uSwitch = 1 ;
@ftpc.o.userPid = substr(tcd150.cd150011,1,8) ;
aux.isPutOn = '1'b ;
call putR('** getRegionName is switched on by' ||
' userPid' ,70);
call putR('** on TCD150.' ,70);
end;
when ( @ftpc.i.clientId = substr(tcd150.cd150011,1,10) )
do;
@ftpc.o.hasFound = '1'b ;
@ftpc.o.uSwitch = 2 ;
@ftpc.o.clientId = substr(tcd150.cd150011,1,10) ;
aux.isPutOn = '1'b ;
call putR('** getRegionName is switched on by' ||
' clientId' ,70);
call putR('** on TCD150.' ,70);
end;
otherwise
do;
end;
end; /* select */
end;
when ( 100 )
do;
@ftpc.o.hasFound = '0'b;
end;
otherwise
do;
aux.isPutOn = '1'b ;
@isOk = '0'b ;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'Fetch C_tracePidClientId'
, '1010' /* traceId */
) then @isOk = '0'b ;
end;
end;
exec SQL
fetch C_tracePidClientId
into :TCD150 ;
end; /* do while (sqlca.sqlcode = 0) */
if aux.isPutOn then
do;
call putR ('** hasFound : ' ||
@ftpc.o.hasFound ,70);
call putR ('** uSwitch . : ' ||
bin31_to_char(@ftpc.o.uSwitch) ,70);
call putR ('** userPid . : ' ||
@ftpc.o.userPid ,70);
call putR ('** clientId : ' ||
@ftpc.o.clientId ,70);
call putR ('** @isOk . . : ' ||
@isOk ,70);
call putFrame('end ','Fetch_C_tracePidClientId_ok' ,70);
end;
return( @isOk ) ;
end Fetch_C_tracePidClientId_ok;
1/**-----------------------------------------------------------------**/
/** 5.2 Fetch_C_REGION_ok **/
/**-----------------------------------------------------------------**/
Fetch_C_REGION_ok:
Proc ( $p_fcro )
returns ( bit(1) aligned );
dcl $p_fcro ptr ;
dcl 1 @fcro based ($p_fcro) ,
3 i ,
5 dummy char( 0) ,
3 o ,
5 found bit ( 1) aligned ,
5 notFound bit ( 1) aligned ,
5 padd_01 char( 2) ,
5 end char( 0) ;
if aux.isPutOn then
do;
call putFrame('start'
,'Fetch_C_REGION_ok' ,70);
end;
/*****************/
/** Fetch Row **/
/*****************/
do;
exec SQL
fetch C_REGION
into %include TCD150V;;
select ( sqlca.sqlcode ) ;
when ( 0 )
do;
@fcro.o.found = '1'b;
end;
when ( 100 )
do;
@fcro.o.notFound = '1'b;
end;
otherwise
do;
aux.isPutOn = '1'b;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'Fetch C_REGION'
, '1010' /* traceId */
) then return('0'b);
end;
end;
end;
if aux.isPutOn then
do;
call putFrame('end '
,'Fetch_C_REGION_ok' ,70);
end;
return('1'b) ;
end Fetch_C_REGION_ok;
1/**-----------------------------------------------------------------**/
/** 5.26 putM **/
/**-----------------------------------------------------------------**/
putM: proc($str , $pos);
dcl $str char(*);
dcl $pos bin fixed(31);
dcl @pos bin fixed(31) init( 0) ;
dcl @i bin fixed(31) init( 0) ;
dcl @line char(200) var init('') ;
dcl 1 @l , /* length */
3 asa bin fixed(31) init( 1) ,
3 pgmName bin fixed(31) init( 8) ,
3 corr bin fixed(31) init( 1) , /* Korrektur */
3 str bin fixed(31) init( 0) ;
dcl 1 @p , /* position */
3 t1 bin fixed(31) init( 66) , /* Tabulator 1 */
3 t2 bin fixed(31) init( 96) , /* Tabulator 2 */
3 t3 bin fixed(31) init(115) ; /* Tabulator 3 */
/* PutProc mit Wiederholbarem Input */
if ( aux.isPutOn ) then
do;
@pos = $pos ;
do; /* Repeated Character */
do @i = @l.asa+@l.pgmName+1+@l.pgmName+1+@l.corr to @pos ;
@line = @line || $str ;
end; /* next */
@line = @line || ' ' ;
end; /* Repeated Character */
do; /* Füllen bis Tab1 */
do @i = @pos+@l.corr to @p.t1 ;
@line = @line || ' ' ;
end; /* next */
end; /* Füllen bis Datum */
@pos = max(@pos , @p.t1) ;
do; /* Zeit & Datum */
if ( @pos-@l.corr < @p.t2 ) then
do;
@line = @line || translate('ij:kl:mn:opq abcd-ef-gh'
, datetime()
,'abcdefghijklmnopq'
);
end;
end; /* Zeit & Datum */
put file(CDPUT3_Sysprint) edit( CDPUT3_mainPgmName || ' ' ||
'YCDPUT3 ' ||
@line )(skip,a);
end;
end; /* putM */
1/**-----------------------------------------------------------------**/
/** 5.26 putR **/
/**-----------------------------------------------------------------**/
putR: proc($str , $pos);
dcl $str char(*);
dcl $pos bin fixed(31);
dcl @pos bin fixed(31) init( 0) ;
dcl 1 @l , /* length */
3 asa bin fixed(31) init( 1) ,
3 pgmName bin fixed(31) init( 8) ,
3 corr bin fixed(31) init( 1) , /* Korrektur */
3 str bin fixed(31) init( 0) ;
dcl 1 @p , /* position */
3 t1 bin fixed(31) init( 66) , /* Tabulator 1 */
3 t2 bin fixed(31) init( 96) , /* Tabulator 2 */
3 t3 bin fixed(31) init(115) ; /* Tabulator 3 */
dcl @i bin fixed(31) init( 0) ;
dcl @line char(200) var init( '') ;
/* PutProc mit Rahmen */
/* Dieses Procedure schreibt nur, wenn der Puts-Flag */
/* auf "on" gesetzt ist. */
if ( aux.isPutOn ) then
do;
@pos = $pos ;
do; /* Vorbereitung */
@l.str = length($str) ;
do @i = @l.str to 1 by -1
while (substr($str, @i, 1) = '') ;
end;
@l.str = @i ;
end; /* Vorbereitung */
do; /* @str */
@line = substr( $str, 1, @l.str ) ;
end; /* @str */
@pos = max(@pos , @l.str+@l.asa+2*@l.pgmName+2+4) ;
do; /* Rahmen-Abschluss */
do @i = @l.asa+@l.pgmName+1
+@l.pgmName+1+@l.str to @pos-@l.corr-4 ;
@line = @line || ' ' ;
end; /* next */
if ( @pos-@l.corr < @p.t3 ) then
@line = @line || ' ** ' ;
end; /* Rahmen-Abschluss */
do; /* Füllen bis Tab1 */
do @i = @pos+@l.corr to @p.t1 ;
@line = @line || ' ' ;
end; /* next */
end; /* Füllen bis Tab1 */
do; /* Zeit & Datum */
if ( @pos-@l.corr < @p.t2 ) then
do;
@line = @line || translate('ij:kl:mn:opq abcd-ef-gh'
, datetime()
,'abcdefghijklmnopq'
);
end;
end; /* Zeit & Datum */
put file(CDPUT3_Sysprint) edit( CDPUT3_mainPgmName || ' ' ||
'YCDPUT3 ' ||
@line )(skip,a);
end;
end; /* putR */
/**-----------------------------------------------------------------**/
/** 5.1 getDataFromTCD152_ok **/
/**-----------------------------------------------------------------**/
getDataFromTCD152_ok:
Proc ( $p_gydo )
returns ( bit(1) aligned );
dcl $p_gydo ptr ;
dcl 1 @getTcd152 based( $p_gydo ) ,
3 i ,
5 dummy char( 0) ,
3 o ,
5 getRegionName char( 1) ,
5 hasFound bit(1)aligned ,
5 padd_01 char( 2) ,
5 end char( 0) ;
dcl @isOk bit(1)aligned init('1'b);
if aux.isPutOn then
do;
call putFrame('start','getDataFromTCD152_ok' ,70);
end;
/**------------------------**/
/** Initializing Output **/
/**------------------------**/
do;
@getTcd152.o.getRegionName = '' ;
@getTcd152.o.hasFound = '0'b ;
end;
/**--------**/
/** open **/
/**--------**/
if ^open_C_tcd152_ok () then
do;
@isOk = '0'b;
end;
else
do;
/**---------**/
/** fetch **/
/**---------**/
dcl 1 @fcyo ,
3 i ,
5 dummy char( 0) init( '' ) ,
3 o ,
5 hasFound bit ( 1) aligned init('0'b) ,
5 padd_01 char( 3) init( '' ) ,
5 end char( 0) init( '' ) ;
if ^Fetch_C_tcd152_ok ( addr(@fcyo) ) then
do;
@isOk = '0'b;
end;
else
do;
@getTcd152.o.hasFound = @fcyo.o.hasFound ;
call putR ('** hasFound (TCD152) : ' ||
@getTcd152.o.hasFound ,70);
if ( @fcyo.o.hasFound ) then
do;
/**---------**/
/** put **/
/**---------**/
if putTcd152_ok() then ;
CDPUT3_inOrExclude = tcd152.inOrExclude ;
CDPUT3_clientIdA ( 1) = tcd152.clientIdA_01 ;
CDPUT3_clientIdA ( 2) = tcd152.clientIdA_02 ;
CDPUT3_clientIdA ( 3) = tcd152.clientIdA_03 ;
CDPUT3_clientIdA ( 4) = tcd152.clientIdA_04 ;
CDPUT3_clientIdA ( 5) = tcd152.clientIdA_05 ;
CDPUT3_clientIdA ( 6) = tcd152.clientIdA_06 ;
CDPUT3_clientIdA ( 7) = tcd152.clientIdA_07 ;
CDPUT3_clientIdA ( 8) = tcd152.clientIdA_08 ;
CDPUT3_clientIdA ( 9) = tcd152.clientIdA_09 ;
CDPUT3_clientIdA (10) = tcd152.clientIdA_10 ;
CDPUT3_forApplUse( 1) = tcd152.forApplUse_01 ;
CDPUT3_forApplUse( 2) = tcd152.forApplUse_02 ;
CDPUT3_forApplUse( 3) = tcd152.forApplUse_03 ;
CDPUT3_currentDate = substr(tcd152.currentTs,1,10);
CDPUT3_currentTime = substr(tcd152.currentTs,12,8);
CDPUT3_dayOfWeek = tcd152.dayOfWeek ;
end;
end; /* fetch */
end; /* open */
/**---------**/
/** close **/
/**---------**/
if ^close_C_tcd152_ok () then
do;
@isOk = '0'b;
end;
if aux.isPutOn then
do;
call putR ('**' ,70);
call putR ('** @isOk . . : ' ||
@isOk ,70);
call putFrame('end ','getDataFromTCD152_ok' ,70);
end;
return( @isOk ) ;
end getDataFromTCD152_ok ;
/**-----------------------------------------------------------------**/
/** 5.1 getPidClientIdFromTCD150_ok **/
/**-----------------------------------------------------------------**/
getPidClientIdFromTCD150_ok:
Proc ( $p_gpcif )
returns ( bit(1) aligned );
dcl $p_gpcif ptr ;
dcl 1 @gpcif based( $p_gpcif ) ,
3 i ,
5 userPid char( 8) ,
5 clientId char(10) ,
5 padd_01 char( 2) ,
3 o ,
5 hasFound bit(1)aligned ,
5 padd_01 char( 3) ,
5 traceLevel bin fixed(31) ,
5 getRegionName char( 1) ,
5 padd_02 char( 3) ,
3 endOfStruc char( 0) ;
dcl @isOk bit(1)aligned init('1'b);
if aux.isPutOn then
do;
call putFrame('start','getPidClientIdFromTCD150_ok' ,70);
end;
/**------------------------**/
/** Initializing Output **/
/**------------------------**/
do;
@gpcif.o.getRegionName = 'N' ;
@gpcif.o.hasFound = '0'b ;
end;
/**--------**/
/** open **/
/**--------**/
/* get all "Trace" */
if ^open_C_tracePidClientId_ok () then
do;
@isOk = '0'b;
end;
else
do;
/**---------**/
/** fetch **/
/**---------**/
dcl 1 @ftpc ,
3 i ,
5 userPid char( 8) init( '' ) ,
5 clientId char(10) init( '' ) ,
5 padd_01 char( 2) init( '' ) ,
3 o ,
5 hasFound bit ( 1) aligned init('0'b) ,
5 padd_01 char( 3) init( '' ) ,
5 uSwitch bin fixed(31) init( 0 ) ,
5 userPid char( 8) init( '' ) ,
5 clientId char(10) init( '' ) ,
5 padd_02 char( 2) init( '' ) ,
3 endOfStruc char( 0) init( '' ) ;
@ftpc.i.userPid = @gpcif.i.userPid ;
@ftpc.i.clientId = @gpcif.i.clientId ;
if ^Fetch_C_tracePidClientId_ok ( addr(@ftpc) ) then
do;
@isOk = '0'b;
end;
else
do;
@gpcif.o.hasFound = @ftpc.o.hasFound ;
if ( @gpcif.o.hasFound ) then
do;
aux.isPutOn = '1'b ;
@gpcif.o.traceLevel = 0 ;
@gpcif.o.getRegionName = 'Y' ;
end;
end; /* fetch */
end; /* open */
/**---------**/
/** close **/
/**---------**/
if ^close_C_tracePidClientId_ok () then
do;
@isOk = '0'b;
end;
if aux.isPutOn then
do;
call putR ('**' ,70);
call putR ('** hasFound . . . : ' ||
@gpcif.o.hasFound ,70);
call putR ('** traceLevel . . : ' ||
bin31_to_char(@gpcif.o.traceLevel) ,70);
call putR ('** getRegionName : ' ||
@gpcif.o.getRegionName ,70);
call putR ('** @isOk . . . . : ' ||
@isOk ,70);
call putFrame('end ','getPidClientIdFromTCD150_ok' ,70);
end;
return( @isOk ) ;
end /* getPidClientIdFromTCD150_ok */ ;
/**-----------------------------------------------------------------**/
/** 5.1 putTcd152_ok **/
/**-----------------------------------------------------------------**/
putTcd152_ok:
Proc
returns ( bit(1) aligned );
dcl @isOk bit(1)aligned init('1'b);
dcl @i bin fixed(31) init( 0 );
dcl @m bin fixed(31) init( 0 );
if aux.isPutOn then
do;
call putFrame ('start','putTcd152_ok' ,70);
call putR ('** Key' ,70);
call putR ('** serviceId . . . . : ' ||
tcd152.serviceId ,70);
call putR ('** Alternative Key' ,70);
call putR ('** operationName . . : ' ||
tcd152.operationName ,70);
call putR ('** interfaceName . . : ' ||
tcd152.interfaceName ,70);
call putR ('** pgmName . . . . . : ' ||
tcd152.pgmName ,70);
call putR ('** Trace-Level' ,70);
call putR ('** general' ,70);
call putR ('** traceLvlAll . . : ' ||
tcd152.traceLvlAll ,70);
call putR ('** getRegionAll . : ' ||
tcd152.getRegionAll ,70);
/**------------**/
/** pidStruc **/
/**------------**/
do;
call putR ('** pidStruc' ,70);
dcl
1 @pidStruc based( addr (tcd152.pid_01) ) ,
3 a(10) ,
5 pid char( 8) ,
5 clientId char(10) ,
5 traceLvl char( 1) ,
5 getRegion char( 1) ,
3 endOfStruc char( 0) ;
@m = hbound(@pidStruc.a,1) ;
do @i=1 to @m
while( @pidStruc.a(@i).pid ^= ''
| @pidStruc.a(@i).clientId ^= '' );
call putR ('** '||putIP(@i,@m) ,70);
call putR ('** pid . . . . . : ' ||
@pidStruc.a(@i).pid ,70);
call putR ('** clientId . . : ' ||
@pidStruc.a(@i).clientId ,70);
call putR ('** traceLvl . . : ' ||
@pidStruc.a(@i).traceLvl ,70);
call putR ('** getRegion . . : ' ||
@pidStruc.a(@i).getRegion ,70);
end; /* do @i=1 to @m */
if @i=1 then
do;
call putR ('** none available' ,70);
end;
end;
/**--------------**/
/** components **/
/**--------------**/
do;
call putR ('** components' ,70);
dcl
1 @components based( addr (tcd152.componentName_01) ) ,
3 a(10) ,
5 componentName char( 8) ,
5 componentTLvl char( 1) ,
3 endOfStruc char( 0) ;
@m = hbound(@components.a,1) ;
do @i=1 to @m
while( @components.a(@i).componentName ^= '' );
call putR ('** '||putIP(@i,@m) ,70);
call putR ('** componentName . : ' ||
@components.a(@i).componentName ,70);
call putR ('** componentTLvl . : ' ||
@components.a(@i).componentTLvl ,70);
end; /* do @i=1 to @m */
if @i=1 then
do;
call putR ('** none available' ,70);
end;
end;
/**--------------**/
/** clientIdA **/
/**--------------**/
do;
call putR ('** clientId allowed' ,70);
call putR ('** inOrExclude . . . : ' ||
tcd152.inOrExclude ,70);
dcl
1 @clientIdA based( addr (tcd152.clientIdA_01) ) ,
3 a(10) ,
5 clientIdA char(10) ,
3 endOfStruc char( 0) ;
@m = hbound(@components.a,1) ;
do @i=1 to @m
while( @clientIdA.a(@i).clientIdA ^= '' );
call putR ('** '||putIP(@i,@m) ,70);
call putR ('** clientIdA . . . : ' ||
@clientIdA.a(@i).clientIdA ,70);
end; /* do @i=1 to @m */
if @i=1 then
do;
call putR ('** none available' ,70);
end;
end;
/**--------------**/
/** forApplUse **/
/**--------------**/
do;
call putR ('** forApplUse' ,70);
dcl
1 @forApplUse based( addr (tcd152.forApplUse_01) ) ,
3 a( 3) ,
5 forApplUse char(200) ,
3 endOfStruc char( 0) ;
@m = hbound(@forApplUse.a,1) ;
do @i=1 to @m
while( @forApplUse.a(@i).forApplUse ^= '' );
call putR ('** '||putIP(@i,@m) ,70);
call putR ('** forApplUse . . : ' ||
@forApplUse.a(@i).forApplUse ,70);
end; /* do @i=1 to @m */
if @i=1 then
do;
call putR ('** none available' ,70);
end;
end;
/**--------------**/
/** date **/
/**--------------**/
do;
call putR ('** date' ,70);
call putR ('** currentTs . . . : ' ||
tcd152.currentTs ,70);
call putR ('** dayOfWeek . . . : ' ||
bin31_to_char(tcd152.dayOfWeek) ,70);
end;
call putFrame ('end ','putTcd152_ok' ,70);
end;
return( @isOk ) ;
end putTcd152_ok ;
/**-----------------------------------------------------------------**/
/** 5.01 fill_tcd153_struc_ok **/
/**-----------------------------------------------------------------**/
fill_tcd153_struc_ok:
Proc
returns ( bit(1) aligned );
dcl @isOk bit(1) aligned init('1'b);
if aux.isPutOn then
do;
call putFrame('start','fill_tcd153_struc_ok' ,70);
end;
tcd153.start_ts = CDPUT3_start_ts ;
tcd153.interfaceName = CDPUT3_interfaceName ;
tcd153.operationName = CDPUT3_operationName ;
tcd153.trx = CDPUT3_trxName ;
tcd153.pgmName = CDPUT3_pgmName ;
tcd153.clientId = CDPUT3_clientId ;
tcd153.pid = in.CDPUT3_pid ;
tcd153.traceLevel = bin31_to_char1(out.CDPUT3_traceLevel) ;
tcd153.duration_ts = getDifference( CDPUT3_start_ts
, CDPUT3_end_ts );
tcd153.serviceId = CDPUT3_serviceId ;
tcd153.forApplUse_01 = CDPUT3_153ForApplUse_01;
;
do; /* Region holen und zuweisen */
%include IMSINFO ; 004784
%include YYIMS ; 004784
CALL YYIMS(IMSRC,IMSTKN,IMSWRK,PIMSINFO);
/*
dcl @cd150011 char(40) init('');
@cd150011 = I1_MJOBNAME || ' ' ||
I1_MJOBNR || ' ' ||
in.CDPUT3_pid || ' ' ||
translate('ij:kl:mn:opq'
, datetime()
,'abcdefghijklmnopq' );
*/
tcd153.regionName = I1_MJOBNAME ;
tcd153.jobNr = I1_MJOBNR ;
end; /* Region holen und zuweisen */
if aux.isPutOn then
do;
call putR ('** start_ts . . : ' ||
tcd153.start_ts ,70);
call putR ('** interfaceName : ' ||
tcd153.interfaceName ,70);
call putR ('** operationName : ' ||
tcd153.operationName ,70);
call putR ('** trx . . . . . : ' ||
tcd153.trx ,70);
call putR ('** pgmName . . . : ' ||
tcd153.pgmName ,70);
call putR ('** clientId . . : ' ||
tcd153.clientId ,70);
call putR ('** pid . . . . . : ' ||
tcd153.pid ,70);
call putR ('** traceLevel . : ' ||
tcd153.traceLevel ,70);
call putR ('** regionName . : ' ||
tcd153.regionName ,70);
call putR ('** jobNr . . . . : ' ||
tcd153.jobNr ,70);
call putR ('** duration_ts . : ' ||
tcd153.duration_ts ,70);
call putR ('** serviceId . . : ' ||
tcd153.serviceId ,70);
call putR ('** forApplUse_01 : ' ||
tcd153.forApplUse_01 ,70);
end;
/*
if ^submit_CD99 () then @isOk = '0'b ;
*/
if aux.isPutOn then
do;
call putFrame('end ','fill_tcd153_struc_ok' ,70);
end;
return( @isOk ) ;
end fill_tcd153_struc_ok ;
/**-----------------------------------------------------------------**/
/** 5.01 getDifference **/
/**-----------------------------------------------------------------**/
getDifference:
Proc ( $start_ts
, $end_ts )
returns ( char(26) );
dcl $start_ts char(26) ;
dcl @start_ts char(26) ;
dcl 1 @start based( addr(@start_ts) ) ,
3 yyyy pic'9999' ,
3 strich1 char(1) ,
3 mo pic'99' ,
3 strich2 char(1) ,
3 dd pic'99' ,
3 strich3 char(1) ,
3 hh pic'99' ,
3 punkt1 char(1) ,
3 mi pic'99' ,
3 punkt2 char(1) ,
3 ss pic'99' ,
3 punkt3 char(1) ,
3 mmmmmm pic'999999' ,
3 ende char(0) ;
dcl $end_ts char(26) ;
dcl @end_ts char(26) ;
dcl 1 @ende based( addr(@end_ts) ) ,
3 yyyy pic'9999' ,
3 strich1 char(1) ,
3 mo pic'99' ,
3 strich2 char(1) ,
3 dd pic'99' ,
3 strich3 char(1) ,
3 hh pic'99' ,
3 punkt1 char(1) ,
3 mi pic'99' ,
3 punkt2 char(1) ,
3 ss pic'99' ,
3 punkt3 char(1) ,
3 mmmmmm pic'999999' ,
3 ende char(0) ;
dcl @difference_ts char(26) init('') ;
dcl 1 @diff based( addr(@difference_ts) ) ,
3 yyyy pic'9999' ,
3 strich1 char(1) ,
3 mo pic'99' ,
3 strich2 char(1) ,
3 dd pic'99' ,
3 strich3 char(1) ,
3 hh pic'99' ,
3 punkt1 char(1) ,
3 mi pic'99' ,
3 punkt2 char(1) ,
3 ss pic'99' ,
3 punkt3 char(1) ,
3 mmmmmm pic'999999' ,
3 ende char(0) ;
dcl @isOk bit ( 1) aligned init('1'b);
@start_ts = $start_ts ;
@end_ts = $end_ts ;
@diff.yyyy = '0001' ;
@diff.strich1 = '-' ;
@diff.mo = '01' ;
@diff.strich2 = '-' ;
@diff.dd = '01' ;
@diff.strich3 = '-' ;
@diff.hh = '' ;
@diff.punkt1 = '.' ;
@diff.mi = '' ;
@diff.punkt2 = '.' ;
@diff.ss = '' ;
@diff.punkt3 = '.' ;
@diff.mmmmmm = '' ;
if aux.isPutOn then
do;
call putFrame('start','getDifference' ,80);
call putR ('** end_ts . . . . : ' ||
$end_ts ,80);
call putR ('** start_ts . . . : ' ||
$start_ts ,80);
end;
if ( @ende.mmmmmm - @start.mmmmmm >= 0 ) then
do;
@diff.mmmmmm = @ende.mmmmmm - @start.mmmmmm ;
end;
else
do;
@diff.mmmmmm = @ende.mmmmmm - @start.mmmmmm + 1000000 ;
@start.ss = @start.ss + 1 ;
end;
if ( @ende.ss - @start.ss >= 0 ) then
do;
@diff.ss = @ende.ss - @start.ss ;
end;
else
do;
@diff.ss = @ende.ss - @start.ss + 60 ;
@start.mi = @start.mi + 1 ;
end;
if ( @ende.mi - @start.mi >= 0 ) then
do;
@diff.mi = @ende.mi - @start.mi ;
end;
else
do;
@diff.mi = @ende.mi - @start.mi + 60 ;
@start.hh = @start.hh + 1 ;
end;
if ( @ende.hh - @start.hh >= 0 ) then
do;
@diff.hh = @ende.hh - @start.hh ;
end;
else
do;
@diff.hh = @ende.hh - @start.hh + 24 ;
@start.dd = @start.dd + 1 ;
end;
/**--------**/
/** Tage **/
/**--------**/
if ( @ende.dd ^= @start.dd ) then
do;
@isOk = '0'b;
end;
if ^@isOk then
do;
@difference_ts = '0001-01-01-00.00.01.000000' ;
end;
if aux.isPutOn then
do;
call putR ('** difference_ts . : ' ||
@difference_ts ,80);
call putFrame('end ','getDifference' ,80);
end;
return( @difference_ts ) ;
end getDifference ;
/**-----------------------------------------------------------------**/
/** 5.1 open_C_tracePidClientId_ok **/
/**-----------------------------------------------------------------**/
open_C_tracePidClientId_ok:
Proc
returns ( bit(1) aligned );
dcl @isOk bit(1) aligned init('1'b);
exec SQL open C_tracePidClientId ;
aux.C_tracePidClientId_open = '1'b ;
select (sqlca.sqlcode) ;
when ( 0 )
do;
/* wunderbar */
@isOk = '1'b ;
end;
otherwise
do;
aux.isPutOn = '1'b;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'open von C_tracePidClientId'
, '1010' /* traceId */
) then @isOk = '0'b ;
@isOk = '0'b ;
end;
end; /* select */
return( @isOk ) ;
end open_C_tracePidClientId_ok ;
/**-----------------------------------------------------------------**/
/** 5.1 open_C_tcd152_ok **/
/**-----------------------------------------------------------------**/
open_C_tcd152_ok:
Proc
returns ( bit(1) aligned );
dcl @isOk bit(1) aligned init('1'b);
call putFrame('start','open_C_tcd152_ok' ,70);
call putR ('** serviceId . . : ' ||
CDPUT3_serviceId ,70);
call putR ('** interfaceName : ' ||
CDPUT3_interfaceName ,70);
exec SQL open C_tcd152 ;
aux.C_tcd152_open = '1'b ;
select (sqlca.sqlcode) ;
when ( 0 )
do;
/* wunderbar */
@isOk = '1'b ;
end;
otherwise
do;
aux.isPutOn = '1'b;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'open von C_tcd152'
, '1010' /* traceId */
) then @isOk = '0'b ;
@isOk = '0'b ;
end;
end; /* select */
call putFrame('end ','open_C_tcd152_ok' ,70);
return( @isOk ) ;
end open_C_tcd152_ok ;
/**-----------------------------------------------------------------**/
/** 5.1 close_C_tcd152_ok **/
/**-----------------------------------------------------------------**/
close_C_tcd152_ok:
Proc
returns ( bit(1) aligned );
dcl @isOk bit(1) aligned init('1'b);
/***********************/
/** Cursor C_tcd152 **/
/***********************/
if aux.C_tcd152_open then
do;
exec SQL close C_tcd152;
select (sqlca.sqlcode) ;
when ( 0 )
do;
/* wunderbar */
@isOk = '1'b ;
aux.C_tcd152_open = '0'b ;
end;
otherwise
do;
aux.isPutOn = '1'b;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'closing of C_tcd152'
, '1010' /* traceId */
) then @isOk = '0'b ;
@isOk = '0'b ;
end;
end; /* select */
end;
return( @isOk ) ;
end close_C_tcd152_ok ;
/**-----------------------------------------------------------------**/
/** 5.1 close_C_tracePidClientId_ok **/
/**-----------------------------------------------------------------**/
close_C_tracePidClientId_ok:
Proc
returns ( bit(1) aligned );
dcl @isOk bit(1) aligned init('1'b);
/**********************************/
/** Cursor C_tracePidClientId **/
/**********************************/
if aux.C_tracePidClientId_open then
do;
exec SQL close C_tracePidClientId;
select (sqlca.sqlcode) ;
when ( 0 )
do;
/* wunderbar */
@isOk = '1'b ;
aux.C_tracePidClientId_open = '0'b ;
end;
otherwise
do;
aux.isPutOn = '1'b;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'closing of C_tracePidClientId'
, '1010' /* traceId */
) then @isOk = '0'b ;
@isOk = '0'b ;
end;
end; /* select */
end;
return( @isOk ) ;
end close_C_tracePidClientId_ok ;
/**-----------------------------------------------------------------**/
/** 5.1 open_C_REGION_ok **/
/**-----------------------------------------------------------------**/
open_C_REGION_ok:
Proc
returns ( bit(1) aligned );
dcl @isOk bit(1) aligned init('1'b);
exec SQL open C_REGION;
aux.C_REGION_open = '1'b ;
select (sqlca.sqlcode) ;
when ( 0 )
do;
/* wunderbar */
@isOk = '1'b ;
end;
otherwise
do;
aux.isPutOn = '1'b;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'open von C_REGION'
, '1010' /* traceId */
) then @isOk = '0'b ;
@isOk = '0'b ;
end;
end; /* select */
return( @isOk ) ;
end open_C_REGION_ok ;
/**-----------------------------------------------------------------**/
/** 5.1 insert_missing_TCD152_ok **/
/**-----------------------------------------------------------------**/
insert_missing_TCD152_ok:
Proc ( $serviceId
, $interfaceName
, $operationName
, $pgmName
, $trxName
)
returns ( bit(1) aligned );
dcl $serviceId char( *) ;
dcl $operationName char( *) ;
dcl $interfaceName char( *) ;
dcl $pgmName char( *) ;
dcl $trxName char( *) ;
dcl @clientIdA_01 char( 10) init('' );
dcl @inOrExclude char( 1) init(' ');
dcl @forApplUse_01 char(200) init('' );
dcl @forApplUse_02 char(200) init('' );
dcl @forApplUse_03 char(200) init('' );
dcl
( @componentName_01
, @componentName_02
, @componentName_03
, @componentName_04
, @componentName_05
, @componentName_06
, @componentName_07
, @componentName_08
, @componentName_09
, @componentName_10 ) char(8) init('') ;
@componentName_01 = 'DIMA' ;
aux.isPutOn = '1'b;
if aux.isPutOn then
do;
call putFrame('start','insert_missing_TCD152_ok' ,70);
call putR('** No Entry on TCD152' ,70);
call putR('** Service-ID : '||CDPUT3_serviceId ,70);
call putR('** Row will be inserted in TCD152.' ,70);
call putR('** Trace-Level is set to "0".' ,70);
call putR('**' ,70);
call putR('** interfaceName : ' ||
$interfaceName ,70);
call putR('** operationName : ' ||
$operationName ,70);
call putR('** serviceId . . : ' ||
$serviceId ,70);
call putR('** pgmName . . . : ' ||
$pgmName ,70);
end;
/*
CDPUT3_forApplUse(1) = '' ;
CDPUT3_forApplUse(2) = '' ;
CDPUT3_forApplUse(3) = 'traceClientAllowed=N¦' ;
*/
@inOrExclude = '' ;
@forApplUse_01 = '' ;
@forApplUse_02 = '' ;
@forApplUse_03 = 'traceClientAllowed=Y¦' ;
/**----------------**/
/** old stuff **/
/** by serviceId **/
/**----------------**/
select ( CDPUT3_serviceId ) ;
/**---------------------------------------------------------**/
/** CI82 - CIFS_CifCreate_2_0 **/
/** CD79 - CIFS_CifCreate_3_0 **/
/**---------------------------------------------------------**/
when ( 'CUS_1081' /* CI82 - CIFS_CifCreate_2_0 - createCif */
, 'CUS_1082' ) /* CD79 - CIFS_CifCreate_3_0 - createCif */
do;
@componentName_01 = 'YCDCCRE' ;
@componentName_02 = 'YCDPLUP' ;
end;
/**---------------------------------------------------------**/
/** CD80 - CIFS_Servicing_Update_3_0 **/
/**---------------------------------------------------------**/
when ( 'CUS_1445' ) /* CD80 - CIFS_Servicing_Update_3_0
- createCifServicings */
do;
@componentName_01 = 'YCD0801' ;
@componentName_02 = 'YCDGETB' ;
end;
when ( 'CUS_1446' ) /* CD80 - CIFS_Servicing_Update_3_0
- getCifsServicings */
do;
@componentName_01 = 'YCD0802' ;
@componentName_02 = 'YCDGETB' ;
end;
when ( 'CUS_1447' ) /* CD80 - CIFS_Servicing_Update_3_0
- updateCifsServicings */
do;
@componentName_01 = 'YCD0803' ;
@componentName_02 = 'YCDGETB' ;
end;
when ( 'CUS_1444' ) /* CD80 - CIFS_Servicing_Update_3_0
- deleteCifServicings */
do;
@componentName_01 = 'YCD0804' ;
@componentName_02 = 'YCDGETB' ;
end;
/**---------------------------------------------------------**/
/** CD81 - CIFS_ServicingHistory_1_0 **/
/**---------------------------------------------------------**/
when ( 'CUS_0008' ) /* CD81 - CIFS_ServicingHistory_1_0
- getCifsServHist */
do;
@componentName_01 = 'YCD0812' ;
@componentName_02 = 'YCDGETB' ;
end;
/**---------------------------------------------------------**/
/** CD83 - CIFS_CCSegmentation_1_0 **/
/**---------------------------------------------------------**/
when ( 'CUS_0030' ) /* CD83 - CIFS_CCSegmentation_1_0
- getCCSegmentation */
do;
@componentName_01 = 'YCDCCG' ;
@componentName_02 = 'YCDAURA' ;
end;
/**----------------------------------------------------------**/
/** CD84 - CIFS_CCSegmentation_Update_1_0 **/
/**----------------------------------------------------------**/
when ( 'CUS_0031' ) /* CD84 - CIFS_CCSegmentation_Update_1_0
- createCCSegmentation */
do;
@componentName_01 = 'YCDCCU' ;
@componentName_02 = 'YCDAURA' ;
end;
/**----------------------------------------------------------**/
/** CD84 - CIFS_CCSegmentation_Update_1_0 **/
/**----------------------------------------------------------**/
when ( 'CUS_0032' ) /* CD84 - CIFS_CCSegmentation_Update_1_0
- updateCCSegmentation */
do;
@componentName_01 = 'YCDCCU' ;
@componentName_02 = 'YCDAURA' ;
end;
/**----------------------------------------------------------**/
/** CD84 - CIFS_CCSegmentation_Update_1_0 **/
/**----------------------------------------------------------**/
when ( 'CUS_0033' ) /* CD84 - CIFS_CCSegmentation_Update_1_0
- deleteCCSegmentation */
do;
@componentName_01 = 'YCDCCU' ;
@componentName_02 = 'YCDAURA' ;
end;
/**---------------------------------------------------------**/
/** DA72 - DEPS_Deposit_1_0 **/
/**---------------------------------------------------------**/
when ( 'SEC_1600' /* DA72 - DEPS_Deposit_1_0
- getDepositsShort */
, 'SEC_1601' /* DA72 - DEPS_Deposit_1_0
- getDepositsLong */
, 'SEC_1602' ) /* DA72 - DEPS_Deposit_1_0
- getDepositCurrentValue */
do;
@componentName_01 = 'YDADSTA' ;
end;
/**---------------------------------------------------------**/
/** RM66 - PARS_Partner_update_6_0 **/
/** RM68 - PARS_Relship_6_0 **/
/** RM78 - PARS_RelShip_4_0 **/
/**---------------------------------------------------------**/
when ( 'CUS_1543' /* RM66 - PARS_Partner_update_6_0
- createPartner */
, 'CUS_1553' /* RM66 - PARS_Partner_update_6_0
- updatePartner */
, 'CUS_1563' /* RM66 - PARS_Partner_update_6_0
- deletePartner */
, 'CUS_1579' /* RM68 - PARS_Relship_6_0
- getParsnetRelShipsByUuids */
, 'CUS_1574' /* RM68 - PARS_Relship_6_0
- getParsnetCifs */
, 'CUS_1584' /* RM68 - PARS_Relship_6_0
- getParsnetRelships */
, 'CUS_1572' /* RM78 - PARS_RelShip_4_0
- getParsnetCifs */
, 'CUS_1577' /* RM78 - PARS_RelShip_4_0
- getParsnetRelshipsByUuid */
, 'CUS_1582' /* RM78 - PARS_RelShip_4_0
- getParsnetRelships */
, 'CUS_1587' ) /* RM78 - PARS_RelShip_4_0
- getParsnetCifsByCSID */
do;
@forApplUse_01 = 'STAT STAT auf Stellen 1 - 4 = ' ||
' Operation-Statistik in TRM017A1' ||
'USER USER auf Stellen 81 - 84 = ' ||
' Bildschirmgroesse.. in TRM017A1' ||
' ' ;
end;
/**---------------------------------------------------------**/
/** CI84 - CIFS_Associations_Update_1_0 **/
/**---------------------------------------------------------**/
when ( 'CUS_0120' /* CI84 - CIFS_Associations_Update_1_0
- getUpCifBusAssoc */
, 'CUS_0121' /* CI84 - CIFS_Associations_Update_1_0
- updateCifBusAssoc */
, 'CUS_0122' /* CI84 - CIFS_Associations_Update_1_0
- createCifBusAssoc */
, 'CUS_0123' /* CI84 - CIFS_Associations_Update_1_0
- deleteCifBusAssoc */
, 'CUS_0130' /* CI84 - CIFS_Associations_Update_1_0
- getUpBusBusAssoc */
, 'CUS_0131' /* CI84 - CIFS_Associations_Update_1_0
- updateBusBusAssoc */
, 'CUS_0132' /* CI84 - CIFS_Associations_Update_1_0
- createBusBusAssoc */
, 'CUS_0133' /* CI84 - CIFS_Associations_Update_1_0
- deleteBusBusAssoc */
, 'CUS_0140' /* CI84 - CIFS_Associations_Update_1_0
- getUpCifCifAssoc */
, 'CUS_0141' /* CI84 - CIFS_Associations_Update_1_0
- updateCifCifAssoc */
, 'CUS_0142' /* CI84 - CIFS_Associations_Update_1_0
- createCifCifAssoc */
, 'CUS_0143' ) /* CI84 - CIFS_Associations_Update_1_0
- deleteCifCifAssoc */
do;
@forApplUse_01 = 'Dauer=3000 Versuche=1500 ' ||
' ' ||
' ' ||
' ' ||
' ' ;
end;
/**-------------------------------------------------**/
/** CI67 - CIFS_EWTAddress_2_0 **/
/**-------------------------------------------------**/
when ( 'CUS_0027' /* CI67 - CIFS_EWTAddress_2_0
- createEWTAddress */
, 'CUS_0028' /* CI67 - CIFS_EWTAddress_2_0
- getEWTAddress */
, 'CUS_0029' ) /* CI67 - CIFS_EWTAddress_2_0
- updateEWTAddress */
do;
@inOrExclude = 'I' ;
@clientIdA_01 = 'FN' ;
@forApplUse_01 = ' ' ||
' ' ||
' ' ||
' ' ||
' ' ;
end;
/**-------------------------------------------------------**/
/** CI87 - CIFS_LTInstructUpdate_1_0 **/
/**-------------------------------------------------------**/
when ( 'CUS_1721' /* CI87 - CIFS_LTInstructUpdate_1_0
- createLTInstructs */
, 'CUS_1720' /* CI87 - CIFS_LTInstructUpdate_1_0
- getLTInstructsForCifs */
, 'CUS_1722' /* CI87 - CIFS_LTInstructUpdate_1_0
- updateLTInstructs */
, 'CUS_1723' ) /* CI87 - CIFS_LTInstructUpdate_1_0
- deleteLTInstructs */
do;
@forApplUse_01 = 'Footprint=Y¦ ' ||
' ' ||
' ' ||
' ' ||
' ' ;
select ( CDPUT3_serviceId ) ;
when ( 'CUS_1721' ) /* - createLTInstructs */
do;
@componentName_01 = 'YCIC870' ;
end;
when ( 'CUS_1722' ) /* - updateLTInstructs */
do;
@componentName_01 = 'YCIU870' ;
end;
when ( 'CUS_1723' ) /* - deleteLTInstructs */
do;
@componentName_01 = 'YCID870' ;
end;
otherwise ;
end; /* select ( CDPUT3_serviceId ) */
end;
otherwise
do;
end;
end; /* select ( CDPUT3_serviceId ) */
select;
/**--------------------**/
/** Special handling **/
/**--------------------**/
when ( $pgmName = 'YCDSP' )
do;
@forApplUse_01 =
'isSOMlogWanted=N¦ ' ||
' ' ||
' ' ||
' ' ||
' ' ;
@forApplUse_03 = '' ;
end;
otherwise
do;
/**--------------------**/
/** By Transactions **/
/**--------------------**/
select ( $trxName );
when ( 'AU55' )
do;
@inOrExclude = '' ;
@clientIdA_01 = '' ;
@componentName_01 = '' ;
end;
when ( 'CA14' )
do;
@inOrExclude = '' ;
@clientIdA_01 = '' ;
@componentName_01 = 'DIMA' ;
@componentName_02 = 'YCDAURA' ;
@componentName_03 = 'YCDSSLI' ;
end;
when ( 'CA37'
, 'CA38'
, 'CA39'
, 'CA40' )
do;
@inOrExclude = '' ;
@clientIdA_01 = '' ;
@componentName_01 = 'YCDGETB' ;
@componentName_02 = 'YCDOEFU' ;
end;
when ( 'CA51'
, 'CA52'
, 'CA53'
, 'CA54' )
do;
@inOrExclude = '' ;
@clientIdA_01 = '' ;
@componentName_01 = '' ;
end;
when ( 'CA59'
, 'CA60' )
do;
@inOrExclude = '' ;
@clientIdA_01 = '' ;
@componentName_01 = 'YCDAURA' ;
@componentName_02 = 'YCDGETB' ;
end;
when ( 'CA90' /* createCifPart_3.0 */
, 'CA93' ) /* updateCifPart_3.0 */
do;
@inOrExclude = '' ;
@clientIdA_01 = '' ;
@componentName_01 = '' ;
@forApplUse_01 =
'Set OpeningDate allowed for max. 8 BUs: ' ||
' ; ; ; ; ; ; ; ;' ||
' ' ||
' ' ||
' ' ;
end;
when ( 'CD55' ) /* getCifsLong_2.0 */
do;
@inOrExclude = '' ;
@clientIdA_01 = '' ;
@componentName_01 = 'DIMA' ;
@forApplUse_01 =
'b1Log=Y¦ ' ||
'maxAllowedInputSeq= 600¦ ' ||
' ' ||
' ' ||
' ' ;
end;
when ( 'CD56' ) /* getCifsLong_3.0 */
do;
@inOrExclude = '' ;
@clientIdA_01 = '' ;
@componentName_01 = '' ;
@forApplUse_01 =
'b1Log=Y¦ ' ||
'maxAllowedInputSeq= 600¦ ' ||
' ' ||
' ' ||
' ' ;
end;
when ( 'CD57' ) /* getCifsLong_4.0 */
do;
@inOrExclude = '' ;
@clientIdA_01 = '' ;
@componentName_01 = '' ;
@forApplUse_01 =
'b1Log=Y¦ ' ||
'maxAllowedInputSeq= 600¦ ' ||
' ' ||
' ' ||
' ' ;
end;
when ( 'CD71' )
do;
@inOrExclude = '' ;
@clientIdA_01 = '' ;
end;
when ( 'CD87' )
do;
@inOrExclude = '' ;
@clientIdA_01 = '' ;
@componentName_01 = '' ;
@forApplUse_01 =
'hasCredit= ¦anyProduct=y¦ ' ||
' ' ||
' ' ||
' ' ||
' ' ;
end;
when ( 'CI60' )
do;
@inOrExclude = '' ;
@clientIdA_01 = '' ;
@componentName_01 = '' ;
end;
when ( 'CI54' ) /* createPartnerAgreementRelationship_1.0 */
do;
@inOrExclude = '' ;
@clientIdA_01 = '' ;
@componentName_01 = 'DIMA' ;
end;
when ( 'CI55' ) /* getPartnerAgreementRelationships_1.0 */
do;
@inOrExclude = '' ;
@clientIdA_01 = '' ;
@componentName_01 = 'DIMA' ;
end;
when ( 'CI56' ) /* deletePartnerAgreementRelationship_1.0 */
do;
@inOrExclude = '' ;
@clientIdA_01 = '' ;
@componentName_01 = 'DIMA' ;
end;
when ( 'CI70' )
do;
@inOrExclude = '' ;
@clientIdA_01 = '' ;
@componentName_01 = '' ;
@forApplUse_01 =
'b1Log=Y¦ ' ||
'maxAllowedInputSeq= 600¦ ' ||
' ' ||
' ' ||
' ' ;
end;
when ( 'CI74' )
do;
@inOrExclude = '' ;
@clientIdA_01 = '' ;
@componentName_01 = 'YCDAURA' ;
@componentName_02 = 'YCDSSLI' ;
end;
when ( 'CI75' )
do;
@inOrExclude = '' ;
@clientIdA_01 = '' ;
@componentName_01 = '' ;
end;
when ( 'CI76' )
do;
@inOrExclude = '' ;
@clientIdA_01 = '' ;
@componentName_01 = '' ;
@forApplUse_01 =
'hasCredit= ¦anyProduct=y¦ ' ||
' ' ||
' ' ||
' ' ||
' ' ;
end;
when ( 'CI88' )
do;
@inOrExclude = '' ;
@clientIdA_01 = '' ;
@componentName_01 = 'YCDAURA' ;
@componentName_02 = 'YCDGETB' ;
end;
when ( 'CI90' )
do;
@inOrExclude = '' ;
@clientIdA_01 = '' ;
@componentName_01 = 'YCI090G' ;
@componentName_02 = 'YCDAURA' ;
@forApplUse_01 =
'b1Log=N¦ ' ||
' ' ||
' ' ||
' ' ||
' ' ;
end;
when ( 'CI91' )
do;
@inOrExclude = '' ;
@clientIdA_01 = '' ;
@componentName_01 = 'YCI090G' ;
@componentName_02 = 'YCDAURA' ;
end;
when ( 'CI93' )
do;
@inOrExclude = 'I' ;
@clientIdA_01 = '' ;
@componentName_01 = '' ;
@componentName_02 = '' ;
end;
when ( 'RM36' )
do;
@inOrExclude = '' ;
@forApplUse_01 = 'TIMELIMIT = 10 '
|| 'SPACELIMIT = 1700 '
|| 'RELLIMIT = 6000 '
|| ' '
|| ' '
;
end;
when ( 'RM37' )
do;
@inOrExclude = '' ;
@forApplUse_01 = 'TIMELIMIT = 10 '
|| 'SPACELIMIT = 1700 '
|| 'RELLIMIT = 6000 '
|| ' '
|| ' '
;
end;
when ( 'RM38' )
do;
@inOrExclude = '' ;
@forApplUse_01 = 'TIMELIMIT = 10 '
|| 'SPACELIMIT = 1700 '
|| 'RELLIMIT = 6000 '
|| ' '
|| ' '
;
end;
when ( 'RM50' )
do;
@inOrExclude = '' ;
@forApplUse_01 = ' '
|| ' '
|| ' '
|| 'alwaysShowPartnerData=N¦ '
|| 'crm4rmicMaxNodes=00000¦ '
;
end;
when ( 'RM65' )
do;
@inOrExclude = '' ;
@forApplUse_01 = 'shortNameTraceWanted=Y¦' ;
end;
when ( 'RM66' )
do;
@inOrExclude = '' ;
end;
when ( 'RM68' )
do;
@inOrExclude = '' ;
@forApplUse_01 = ' '
|| ' '
|| ' '
|| ' '
|| 'crm4rmicMaxNodes=00000¦ '
;
end;
when ( 'RM84' )
do;
@inOrExclude = '' ;
end;
when ( 'RM95' )
do;
@inOrExclude = '' ;
@forApplUse_01 = 'shortNameTraceWanted=Y¦' ;
end;
when ( 'RM98' )
do;
@inOrExclude = '' ;
@forApplUse_01 = 'shortNameTraceWanted=Y¦' ;
end;
otherwise
do;
@inOrExclude = '' ;
end;
end; /* select ( $trxName ) */
end;
end; /* select */
/**------------------------------------------**/
/** DB2 cannot handle atttribute "char(*)" **/
/**------------------------------------------**/
dcl @serviceId char( 20) init('') ;
dcl @interfaceName char( 40) init('') ;
dcl @operationName char( 40) init('') ;
dcl @pgmName char( 8) init('') ;
dcl @trxName char( 8) init('') ;
@serviceId = $serviceId ;
@interfaceName = $interfaceName ;
@operationName = $operationName ;
@pgmName = $pgmName ;
@trxName = $trxName ;
/**------------------------------------------**/
/** Insert tupel into TCD152 **/
/**------------------------------------------**/
exec SQL
insert
into TCD152A1
( serviceId
, interfaceName
, operationName
, pgmName
, trxName
, traceLvlAll
, getRegionAll
, pid_01
, clientId_01
, traceLvl_01
, getRegion_01
, pid_02
, clientId_02
, traceLvl_02
, getRegion_02
, pid_03
, clientId_03
, traceLvl_03
, getRegion_03
, pid_04
, clientId_04
, traceLvl_04
, getRegion_04
, pid_05
, clientId_05
, traceLvl_05
, getRegion_05
, pid_06
, clientId_06
, traceLvl_06
, getRegion_06
, pid_07
, clientId_07
, traceLvl_07
, getRegion_07
, pid_08
, clientId_08
, traceLvl_08
, getRegion_08
, pid_09
, clientId_09
, traceLvl_09
, getRegion_09
, pid_10
, clientId_10
, traceLvl_10
, getRegion_10
, componentName_01
, componentTLvl_01
, componentName_02
, componentTLvl_02
, componentName_03
, componentTLvl_03
, componentName_04
, componentTLvl_04
, componentName_05
, componentTLvl_05
, componentName_06
, componentTLvl_06
, componentName_07
, componentTLvl_07
, componentName_08
, componentTLvl_08
, componentName_09
, componentTLvl_09
, componentName_10
, componentTLvl_10
, inOrExclude
, clientIdA_01
, clientIdA_02
, clientIdA_03
, clientIdA_04
, clientIdA_05
, clientIdA_06
, clientIdA_07
, clientIdA_08
, clientIdA_09
, clientIdA_10
, forApplUse_01
, forApplUse_02
, forApplUse_03
)
values ( :@serviceId
, :@interfaceName
, :@operationName
, :@pgmName
, :@trxName
, '0' /* traceLvlAll */
, 'N' /* getRegionAll */
, '' /* pid_01 */
, '' /* clientId_01 */
, '0' /* traceLvl_01 */
, 'N' /* getRegion_01 */
, '' /* pid_02 */
, '' /* clientId_02 */
, '0' /* traceLvl_02 */
, 'N' /* getRegion_02 */
, '' /* pid_03 */
, '' /* clientId_03 */
, '0' /* traceLvl_03 */
, 'N' /* getRegion_03 */
, '' /* pid_04 */
, '' /* clientId_04 */
, '0' /* traceLvl_04 */
, 'N' /* getRegion_04 */
, '' /* pid_05 */
, '' /* clientId_05 */
, '0' /* traceLvl_05 */
, 'N' /* getRegion_05 */
, '' /* pid_06 */
, '' /* clientId_06 */
, '0' /* traceLvl_06 */
, 'N' /* getRegion_06 */
, '' /* pid_07 */
, '' /* clientId_07 */
, '0' /* traceLvl_07 */
, 'N' /* getRegion_07 */
, '' /* pid_08 */
, '' /* clientId_08 */
, '0' /* traceLvl_08 */
, 'N' /* getRegion_08 */
, '' /* pid_09 */
, '' /* clientId_09 */
, '0' /* traceLvl_09 */
, 'N' /* getRegion_09 */
, '' /* pid_10 */
, '' /* clientId_10 */
, '0' /* traceLvl_10 */
, 'N' /* getRegion_10 */
, :@componentName_01
, ' ' /* componentTLvl_01 */
, :@componentName_02
, ' ' /* componentTLvl_02 */
, :@componentName_03
, ' ' /* componentTLvl_03 */
, :@componentName_04
, ' ' /* componentTLvl_04 */
, :@componentName_05
, ' ' /* componentTLvl_05 */
, :@componentName_06
, ' ' /* componentTLvl_06 */
, :@componentName_07
, ' ' /* componentTLvl_07 */
, :@componentName_08
, ' ' /* componentTLvl_08 */
, :@componentName_09
, ' ' /* componentTLvl_09 */
, :@componentName_10
, ' ' /* componentTLvl_10 */
, :@inOrExclude
, :@clientIdA_01
, '' /* clientIdA_02 */
, '' /* clientIdA_03 */
, '' /* clientIdA_04 */
, '' /* clientIdA_05 */
, '' /* clientIdA_06 */
, '' /* clientIdA_07 */
, '' /* clientIdA_08 */
, '' /* clientIdA_09 */
, '' /* clientIdA_10 */
, :@forApplUse_01
, :@forApplUse_02
, :@forApplUse_03
);
select (sqlca.sqlcode) ;
when ( 0 )
do;
/* insert erfolgreich */
call putR('**' ,70);
call putR('** The Service-ID "' ||
trim($serviceId) ||
'" was successfully ' ,70);
call putR('** added to table TCD152' ,70);
call putR('** Trace-Level = 0 (no print) ' ,70);
CDPUT3_forApplUse(1) = @forApplUse_01 ;
CDPUT3_forApplUse(2) = @forApplUse_02 ;
CDPUT3_forApplUse(2) = @forApplUse_02 ;
out.CDPUT3_traceLevel = 0 ;
end;
otherwise
do;
/* insert */
aux.isPutOn = '1'b;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'insert TCD152'
, '1010' /* traceId */
) then return('0'b);
end;
end; /* select */
if aux.isPutOn then
do;
call putFrame('end '
,'insert_missing_TCD152_ok' ,70);
end;
return('1'b) ;
end insert_missing_TCD152_ok ;
/**-----------------------------------------------------------------**/
/** 5.1 insert_missing_REGION_ok **/
/**-----------------------------------------------------------------**/
insert_missing_REGION_ok:
Proc
returns ( bit(1) aligned );
aux.isPutOn = '1'b;
if aux.isPutOn then
do;
call putM(' ' ,70);
call putM('*' ,70);
call putR('** insert_missing_REGION_ok' ,70);
call putM('*' ,70);
call putR('**' ,70);
call putR('** Kein Eintrag auf TCD150' ,70);
call putR('** Service : '||CDPUT3_metaId ,70);
call putR('** Row in TCD150 eingefuegt' ,70);
call putR('** Trace-Level auf "0" gesetzt' ,70);
call putR('**' ,70);
end;
do; /* Region holen und zuweisen */
%include IMSINFO ; 004784
%include YYIMS ; 004784
CALL YYIMS(IMSRC,IMSTKN,IMSWRK,PIMSINFO);
dcl @cd150011 char(40) init('');
@cd150011 = I1_MJOBNAME || ' ' ||
I1_MJOBNR || ' ' ||
in.CDPUT3_pid || ' ' ||
translate('ij:kl:mn:opq'
, datetime()
,'abcdefghijklmnopq' );
end; /* Region holen und zuweisen */
exec SQL
insert
into TCD150A1
( CD150001
, CD150002
, CD150003
, CD150004
, CD150005
, CD150006
, CD150007
, CD150008
, CD150009
, CD150010
, CD150011 /* Trace-Level */
, CD150012 /* PIDs */
, CD150013 /* Komponenten */
, CD150014
, CD150015
, CD150016
, CD150017
, CD150018
, CD150019
, CD150020
, CD150021 )
values (:CDPUT3_metaId
,'REG '
,'ION '
,:CDPUT3_Bereich /* CIF , PARS , CORB , MACY */
, current timestamp
,'9999-12-31-23.59.59.999999'
,'A'
, current timestamp
, current timestamp
,'A000000'
, :@cd150011 ||
'IA0xR00x JOB12345 A123456 11:MM:SS:TTT ' ||
'IA0xR00x JOB12345 A123456 10:MM:SS:TTT ' ||
'IA0xR00x JOB12345 A123456 09:MM:SS:TTT ' ||
'IA0xR00x JOB12345 A123456 08:MM:SS:TTT ' ||
'IA0xR00x JOB12345 A123456 07:MM:SS:TTT '
,'IA0xR00x JOB12345 A123456 06:MM:SS:TTT ' ||
'IA0xR00x JOB12345 A123456 05:MM:SS:TTT ' ||
'IA0xR00x JOB12345 A123456 04:MM:SS:TTT ' ||
'IA0xR00x JOB12345 A123456 03:MM:SS:TTT ' ||
'IA0xR00x JOB12345 A123456 02:MM:SS:TTT ' ||
'IA0xR00x JOB12345 A123456 01:MM:SS:TTT '
,''
,''
,''
,''
,''
,''
,''
,''
,''
);
select (sqlca.sqlcode) ;
when ( 0 )
do;
/* insert erfolgreich */
call putR('**' ,70);
call putR('** Der Eintrag für ' ||
CDPUT3_metaId ||
' wurde erfolgreich' ,70);
call putR('** in die Tabelle TCD150 eingefuegt.' ,70);
call putR('** Trace-Level = 0 (no print) ' ,70);
call putR('**' ,70);
end;
otherwise
do;
/* insert */
aux.isPutOn = '1'b;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'insert TCD150'
, '1010' /* traceId */
) then return('0'b);
end;
end; /* select */
if aux.isPutOn then
do;
call putFrame('end '
,'insert_missing_REGION_ok' ,70);
end;
return('1'b) ;
end insert_missing_REGION_ok ;
/**-----------------------------------------------------------------**/
/** 5.1 update_REGION_data_ok **/
/**-----------------------------------------------------------------**/
update_REGION_data_ok:
Proc
returns ( bit(1) aligned );
if aux.isPutOn then
do;
call putFrame('start'
,'update_REGION_data_ok' ,70);
end;
exec SQL
update TCD150A1
set CD150008 = current timestamp
, CD150011 = :CD150011
, CD150012 = :CD150012
where CD150001 = :CDPUT3_metaId
and CD150002 = 'REG'
and CD150003 = 'ION'
and CD150005 < :TimeStamp
and CD150006 >= :TimeStamp ;
if ( sqlca.sqlcode ^= 0 ) then
do;
aux.isPutOn = '1'b;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'Update Region-Data'
, '1010' /* traceId */
) then return('0'b);
end;
if aux.isPutOn then
do;
call putFrame('end '
,'update_REGION_data_ok' ,70);
end;
return('1'b) ;
end update_REGION_data_ok ;
/**-----------------------------------------------------------------**/
/** 5.1 fill_REGION_data_ok **/
/**-----------------------------------------------------------------**/
fill_REGION_data_ok:
Proc
returns ( bit(1) aligned );
dcl 1 feld_1 based( addr( cd150011 ) ) ,
3 r (6) , Yc
5 rName char( 8) , Yc
5 fill01 char( 1) , Yc
5 rId char( 8) , Yc
5 fill02 char( 1) , Yc
5 rPid char( 8) , Yc
5 fill03 char( 1) , Yc
5 rTime char( 12) , Yc
5 fill04 char( 1) , Yc
3 end char( 0) ; Yc
dcl 1 feld_2 based( addr( cd150012 ) ) ,
3 r (6) , Yc
5 rName char( 8) , Yc
5 fill01 char( 1) , Yc
5 rId char( 8) , Yc
5 fill02 char( 1) , Yc
5 rPid char( 8) , Yc
5 fill03 char( 1) , Yc
5 rTime char( 12) , Yc
5 fill04 char( 1) , Yc
3 end char( 0) ; Yc
if aux.isPutOn then
do;
call putFrame('start','fill_REGION_data_ok' ,70);
end;
dcl @i bin fixed(31) init(0);
call putR('** feld_2' ,70);
do @i=6 to 2 by -1 ;
feld_2(@i).rName = feld_2(@i-1).rName ;
feld_2(@i).rId = feld_2(@i-1).rId ;
feld_2(@i).rPid = feld_2(@i-1).rPid ;
feld_2(@i).rTime = feld_2(@i-1).rTime ;
if aux.isPutOn then
do;
call putR('** ' || bin31_to_char(@i) ,70);
call putR('** rName : ' ||
feld_2(@i).rName ,70);
call putR('** rId . : ' ||
feld_2(@i).rId ,70);
call putR('** rPid : ' ||
feld_2(@i).rPid ,70);
call putR('** rTime : ' ||
feld_2(@i).rTime ,70);
end;
end; /* next @i */
feld_2(1).rName = feld_1(6).rName ;
feld_2(1).rId = feld_1(6).rId ;
feld_2(1).rPid = feld_1(6).rPid ;
feld_2(1).rTime = feld_1(6).rTime ;
if aux.isPutOn then
do;
call putR('** 1' ,70);
call putR('** rName : ' ||
feld_2( 1).rName ,70);
call putR('** rId . : ' ||
feld_2( 1).rId ,70);
call putR('** rPid : ' ||
feld_2( 1).rPid ,70);
call putR('** rTime : ' ||
feld_2( 1).rTime ,70);
end;
call putR('**' ,70);
call putR('** feld_1' ,70);
do @i=6 to 2 by -1 ;
feld_1(@i).rName = feld_1(@i-1).rName ;
feld_1(@i).rId = feld_1(@i-1).rId ;
feld_1(@i).rPid = feld_1(@i-1).rPid ;
feld_1(@i).rTime = feld_1(@i-1).rTime ;
if aux.isPutOn then
do;
call putR('** ' || bin31_to_char(@i) ,70);
call putR('** rName : ' ||
feld_1(@i).rName ,70);
call putR('** rId . : ' ||
feld_1(@i).rId ,70);
call putR('** rPid : ' ||
feld_1(@i).rPid ,70);
call putR('** rTime : ' ||
feld_1(@i).rTime ,70);
end;
end; /* next @i */
do; /* Region holen und zuweisen */
%include IMSINFO ; 004784
%include YYIMS ; 004784
CALL YYIMS(IMSRC,IMSTKN,IMSWRK,PIMSINFO);
feld_1(1).rName = I1_MJOBNAME ;
feld_1(1).rId = I1_MJOBNR ;
feld_1(1).rPid = in.CDPUT3_pid ;
feld_1(1).rTime = translate('ij:kl:mn:opq'
, datetime()
,'abcdefghijklmnopq' );
end; /* Region holen und zuweisen */
if aux.isPutOn then
do;
call putR('** 1' ,70);
call putR('** rName : ' ||
feld_1( 1).rName ,70);
call putR('** rId . : ' ||
feld_1( 1).rId ,70);
call putR('** rPid : ' ||
feld_1( 1).rPid ,70);
call putR('** rTime : ' ||
feld_1( 1).rTime ,70);
end;
if ^update_REGION_data_ok () then return('0'b);
if aux.isPutOn then
do;
call putFrame('end ','fill_REGION_data_ok' ,70);
end;
return('1'b) ;
end fill_REGION_data_ok ;
1/**-----------------------------------------------------------------**/
/** 5.60 putFrame **/
/**-----------------------------------------------------------------**/
putFrame: proc( $type , $str , $pos);
dcl $type char(5);
dcl $str char(*);
dcl $pos bin fixed(31);
if ( aux.isPutOn ) then
do;
select ( $type ) ;
when ( 'start','Start','START')
do;
call putM(' ' ,$pos);
call putM('*' ,$pos);
call putR('** ' || $str ,$pos);
call putM('*' ,$pos);
call putR('**' ,$pos);
end;
otherwise
do;
call putR('**' ,$pos);
if $str ^= '' then
call putR('** End of ' || $str ,$pos);
call putR('**' ,$pos);
call putM('*' ,$pos);
end;
end; /* select ( $type ) */
end;
end putFrame ;
1/**-----------------------------------------------------------------**/
/** 5.57 is_DB2_Error **/
/**-----------------------------------------------------------------**/
is_DB2_Error: Proc ( $ptr_sqlca
, $text
, $traceId )
returns ( bit(1) aligned ) ;
dcl $ptr_sqlca ptr ;
dcl $text char(*) ;
dcl $traceId char(4) ;
dcl 1 @SQLCA based( $ptr_sqlca ) ,
%include sqlState ;
if @sqlca.sqlcode ^= 0 then
do;
if aux.isPutOn then
do;
call putM('*' ,70);
call putR('** SQL-Maske' ,70);
call putM('*' ,70);
call putR('** SQLCAID = '||@sqlca.SQLCAID ,70);
call putR('** SQLCABC = '||@sqlca.SQLCABC ,70);
call putR('** SQLCODE = '||@sqlca.sqlcode ,70);
call putR('** SQLERRM = '||@sqlca.SQLERRM ,70);
call putR('** SQLERRP = '||@sqlca.SQLERRP ,70);
call putR('** SQLERRD = '||@sqlca.SQLERRd(1) ,70);
call putR('** '||@sqlca.SQLERRd(2) ,70);
call putR('** '||@sqlca.SQLERRd(3) ,70);
call putR('** '||@sqlca.SQLERRd(4) ,70);
call putR('** '||@sqlca.SQLERRd(5) ,70);
call putR('** '||@sqlca.SQLERRd(6) ,70);
call putR('** SQLWARN = '||STRING(@sqlca.SQLWARN) ,70);
call putR('** SQLEXT = '||string(@sqlca.SQLEXT ) ,70);
call putM('*' ,70);
end;
end;
select ( @sqlca.sqlcode ) ;
when ( 0 )
do;
/* Kein Fehler */
end;
when ( 100 )
do;
/* Ist an anderer Stelle codiert. */
end;
when ( -805 )
do;
if aux.isPutOn then do;
call putM('*' ,60);
call putR('** sqlCode : -805' ,60);
call putR('** --------------' ,60);
call putR('** - DBRM nicht aktuell' ,60);
call putR('** - Collection-ID fehlt' ,60);
call putM('*' ,60);
end;
call raiseEx
( 'GLO00002'
, 'S'
, '1501'
, $traceId
, ''
, '' , '' , '' , ''
, addr(@sqlca) , null()
, 'DBRM nicht aktuell RC:-805'
);
return('1'b);
end;
when ( -904 , -923 , -924 )
do;
if aux.isPutOn then do;
call putM('*' ,60);
call putR('** DB2 nicht verfügbar RC:-904/-923/-924',60);
call putM('*' ,60);
end;
call raiseEx
( 'GLO00002'
, 'S'
, '1501'
, $traceId
, ''
, '' , '' , '' , ''
, addr(@sqlca) , null()
, $text||': DB2 nicht verfügbar RC:-904/-923/-924'
);
return('1'b);
end;
otherwise
do;
if aux.isPutOn then do;
call putM('*' ,60);
call putR('** '||$text||' DB2-Fehler RC=' ||
bin31_to_char( @sqlca.sqlcode ) ,60);
call putM('*' ,60);
end;
call raiseEx
( 'GLO00002'
, 'S'
, '1501'
, $traceId
, ''
, '' , '' , '' , ''
, addr(@sqlca) , null()
, $text || 'DB2-Fehler RC='
|| bin31_to_char( @sqlca.sqlcode )
);
return('1'b);
end;
end;
return('0'b);
end is_DB2_Error ;
1/**-----------------------------------------------------------------**/
/** 5.37 raiseEx **/
/**-----------------------------------------------------------------**/
raiseEx: Proc( @mainID
, @level
, @3270
, @traceId
, @ctx
, @param1Temp
, @param2Temp
, @param3Temp
, @param4Temp
, @pSQL
, @pIMS
, @textTemp
) ;
dcl @mainID char( 8) ;
dcl @level char( 1) ;
dcl @3270 char( 4) ;
dcl @traceId char( 4) ;
dcl @ctx char( 8) ;
dcl @param1Temp char( * ) ;
dcl @param1 char( 30) init('');
dcl @param2Temp char( * ) ;
dcl @param2 char( 30) init('');
dcl @param3Temp char( * ) ;
dcl @param3 char( 30) init('');
dcl @param4Temp char( * ) ;
dcl @param4 char( 30) init('');
dcl @pSQL ptr ;
dcl @pIMS ptr ;
dcl @textTemp char( * ) ;
dcl @text char(200) init('');
@param1 = substr( @param1Temp,1,min( 30,length(@param1Temp)) ) ;
@param2 = substr( @param2Temp,1,min( 30,length(@param2Temp)) ) ;
@param3 = substr( @param3Temp,1,min( 30,length(@param3Temp)) ) ;
@param4 = substr( @param4Temp,1,min( 30,length(@param4Temp)) ) ;
@text = substr( @textTemp ,1,min(200,length(@textTemp )) ) ;
/***************************************/
/* */
/* Exception wird nicht geschrieben. */
/* Es macht keinen Sinn, wenn yCDPUT3 */
/* Exceptions raised. */
/* */
/***************************************/
end raiseEx ;
/**-----------------------------------------------------------------**/
/** 5.05 Fill_CDADMIN_from_CDPUT **/
/**-----------------------------------------------------------------**/
Fill_CDADMIN_from_CDPUT:
proc ;
dcl @i bin fixed(31) init( 0 ) ;
if aux.isPutOn then
do;
call putFrame('start','Fill_CDADMIN_from_CDPUT' ,70);
call putR('** Folgende putFlags sind gesetzt:' ,70);
end;
/**------------------------------**/
/** Compatibility with YCDPUT1 **/
/**------------------------------**/
do;
if ( out.CDPUT3_traceLevel > 1 ) then
do;
aux.putFlag (1) = 'Y' ;
cdadmin.cdadmin_07(1) = 'Y' ;
end;
else
do;
aux.putFlag (1) = 'N' ;
cdadmin.cdadmin_07(1) = 'N' ;
end;
end;
/**--------------------------------**/
/** Umfüllen: CDPUT --> CDADMIN **/
/**--------------------------------**/
do @i=1 to 100;
select ( aux.putFlag(@i) ) ;
when ( 'Y' , 'y' , 'J' , 'j' )
do;
cdadmin.cdadmin_07(@i) = 'Y' ;
call putR('** -' || bin31_to_char3(@i) ||
'. eingeschaltet' ,70);
end;
when ( 'N' , 'n' )
do;
cdadmin.cdadmin_07(@i) = 'N' ;
call putR('** -' || bin31_to_char3(@i) ||
'. ausgeschaltet' ,70);
end;
otherwise
do;
/* no action */
end;
end; /* select */
end; /* next */
cdadmin_traceLevel = out.CDPUT3_traceLevel ;
cdadmin_compName( 1) = tcd152.componentName_01 ;
cdadmin_compName( 2) = tcd152.componentName_02 ;
cdadmin_compName( 3) = tcd152.componentName_03 ;
cdadmin_compName( 4) = tcd152.componentName_04 ;
cdadmin_compName( 5) = tcd152.componentName_05 ;
cdadmin_compName( 6) = tcd152.componentName_06 ;
cdadmin_compName( 7) = tcd152.componentName_07 ;
cdadmin_compName( 8) = tcd152.componentName_08 ;
cdadmin_compName( 9) = tcd152.componentName_09 ;
cdadmin_compName(10) = tcd152.componentName_10 ;
cdadmin_compTLvl( 1) = tcd152.componentTLvl_01 ;
cdadmin_compTLvl( 2) = tcd152.componentTLvl_02 ;
cdadmin_compTLvl( 3) = tcd152.componentTLvl_03 ;
cdadmin_compTLvl( 4) = tcd152.componentTLvl_04 ;
cdadmin_compTLvl( 5) = tcd152.componentTLvl_05 ;
cdadmin_compTLvl( 6) = tcd152.componentTLvl_06 ;
cdadmin_compTLvl( 7) = tcd152.componentTLvl_07 ;
cdadmin_compTLvl( 8) = tcd152.componentTLvl_08 ;
cdadmin_compTLvl( 9) = tcd152.componentTLvl_09 ;
cdadmin_compTLvl(10) = tcd152.componentTLvl_10 ;
if aux.isPutOn then
do;
call putFrame('end ','Fill_CDADMIN_from_CDPUT' ,70);
end;
end; /* Fill_CDADMIN_from_CDPUT */
1/**-----------------------------------------------------------------**/
/** 5.03 isHeading_ok MDL093 2008-03-19 **/
/**-----------------------------------------------------------------**/
isHeading_ok:
proc ( $moduleName
, $pid )
returns ( bit(1)aligned ) ;
dcl $moduleName char(8) ;
dcl $pid char(8) ;
dcl @isOk bit (1)aligned init('1'b) ;
if aux.isPutOn then
do;
call putM(' ' ,79);
call putM('*' ,79);
call putM('*' ,79);
call putR('**' ,79);
call putR('** Start of '||$moduleName||' on ' ||
translate('rbcd-ef-gh at ij:kl'
, datetime()
,'rbcdefghijklmnopq'
) ,79);
call putR('**' ,79);
call putM('*' ,79);
call putM('*' ,79);
call putM(' ' ,79);
call putM('*' ,79);
call putR('**' ,79);
call putR('** ' || COMP_VERS ,79);
call putR('** ' || COMP_TIME ,79);
call putR('**' ,79);
call putR('** PID : ' ||
$pid ,79);
call putR('**' ,79);
call putM('*' ,79);
end;
return( @isOk ) ;
end /* isHeading_ok */ ;
/**-----------------------------------------------------------------**/
/** 5.1 set_default_output_values_ok **/
/**-----------------------------------------------------------------**/
set_default_output_values_ok:
Proc
returns ( bit(1) aligned ) ;
if aux.isPutOn then
do;
call putFrame('start'
,'set_default_output_values_ok' ,70);
end;
/**-----------------**/
/** Default-Werte **/
/**-----------------**/
do;
yCDPUT3k.out.CDPUT3_rc = 0 ;
yCDPUT3k.out.CDPUT3_traceLevel = 0 ;
yCDPUT3k.out.CDPUT3_traceLevelModule = 0 ;
yCDPUT3k.out.CDPUT3_pid( * ) = '' ;
yCDPUT3k.out.CDPUT3_inOrExclude = '' ;
yCDPUT3k.out.CDPUT3_clientIdA (*) = '' ;
yCDPUT3k.out.CDPUT3_forApplUse(*) = '' ;
end;
if aux.isPutOn then
do;
call putFrame('end '
,'set_default_output_values_ok' ,70);
end;
return('1'b);
end set_default_output_values_ok ;
/**-----------------------------------------------------------------**/
/** 5.05 getTraceLevelForPgmName_ok **/
/**-----------------------------------------------------------------**/
getTraceLevelForPgmName_ok:
proc ( $ptr_itofpn )
returns( bit(1)aligned );
dcl $ptr_itofpn ptr ;
dcl
1 @itofpn based( $ptr_itofpn ) ,
3 i ,
5 traceLevelMainPgm bin fixed(31) ,
5 moduleName char(8) ,
3 o ,
5 traceLevel bin fixed(31) ,
3 endOfStruc char(0) ;
dcl @isOk bit (1)aligned init('1'b) ;
dcl @i bin fixed(31) init( 0 ) ;
if aux.isPutOn then
do;
call putFrame ('start','getTraceLevelForPgmName_ok' ,70);
call putR ('** moduleName . : ' ||
@itofpn.i.moduleName ,70);
call putR ('**' ,70);
call putR ('** traceLevel (general) : ' ||
bin31_to_char(@itofpn.i.traceLevelMainPgm) ,70);
end;
@itofpn.o.traceLevel = @itofpn.i.traceLevelMainPgm ;
/*
if ( @itofpn.o.traceLevel > 0 ) then
do;
*/
call putR ('**' ,70);
do @i=1 to 10
while (cdadmin_compName(@i) ^= @itofpn.i.moduleName);
end;
call putR ('** Search for moduleName ' ||
@itofpn.i.moduleName || ' in table ...' ,70);
if ( @i = 11 ) then
do;
call putR ('** ... moduleName ' ||
@itofpn.i.moduleName || ' not found in table' ,70);
if ( @itofpn.o.traceLevel > 0 ) then
do;
aux.isPutOn = '1'b;
call putR ('** Trace is on because of' ||
' traceLevelMainPgm : ' ||
bin31_to_char(@itofpn.i.traceLevelMainPgm) ,70);
end;
end;
else
do;
call putR ('** ... moduleName ' ||
@itofpn.i.moduleName || ' found in table' ,70);
select ( cdadmin_compTLvl(@i) );
when ( ' ' )
do;
call putR ('** ... no traceLevel specified' ,70);
end;
when ( '0','1','2','3','4','5','6','7','8','9' )
do;
@itofpn.o.traceLevel =
char1_to_bin31(cdadmin_compTLvl(@i),0);
if ( @itofpn.o.traceLevel > 0 ) then aux.isPutOn = '1'b;
call putR ('** traceLevel . : ' ||
cdadmin_compTLvl(@i) ,70);
end;
otherwise
do;
aux.isPutOn = '1'b;
call putR ('** ... wrong traceLevel specified : ' ||
cdadmin_compTLvl(@i) ,70);
end;
end; /* select */
end;
/*
end;
*/
if aux.isPutOn then
do;
call putR ('**' ,70);
call putR ('** traceLevel : ' ||
bin31_to_char(@itofpn.o.traceLevel) ,70);
call putFrame('end ','getTraceLevelForPgmName_ok' ,70);
end;
return( @isOk );
end /* getTraceLevelForPgmName_ok */ ;
CDADMINP
/**-----------------------------------------------------------------**/
/** 5.42 Footing **/
/**-----------------------------------------------------------------**/
Footing:
proc ( @pgmName ) ;
dcl @pgmName char(8) ;
if aux.isPutOn then
do;
call putM(' ' ,79);
call putM('*' ,79);
call putM('*' ,79);
call putR('**' ,79);
call putR('** End of '||@pgmName||' on ' ||
translate('gh.ef.rbcd at ij:kl'
, datetime()
,'rbcdefghijklmnopq'
) ,79);
call putR('**' ,79);
call putM('*' ,79);
call putM('*' ,79);
call putM(' ' ,79);
end;
end Footing ;
/**-----------------------------------------------------------------**/
/** 5.42 submit_CD99 **/
/**-----------------------------------------------------------------**/
submit_CD99:
PROC ( $processType )
returns(bit(1)aligned) ;
dcl @isOk bit(1) aligned init('1'b);
dcl char_20 based char(20) ;
dcl $processType char(1) ;
/*
dcl 1 vt01v1 based(pvt01) ,
%include vt01v1;
dcl pvt01 ptr; /* Pointer vt01-struktur */
/*
dcl povl_vt01 ptr; /*thb130804*/
/*
dcl ovl_vt01 char(32000) based(povl_vt01); /* Overlay auf VT01 */
dcl cdimsstc char(2) ;
/*
pvt01 = addr( vt01v1 ) ;
povl_vt01 = pvt01; /* verschieben zu INTT ??? thb110205*/
/*
dcl 1 nso_ppmopt# based(addr(nso_ppmopt)),
2 opt_lit1 char( 8),
2 opt_aktmsg pic 'ZZ', /* Aktuelle Message Nummer */
/*
2 opt_lit2 char( 5),
2 opt_totmsg pic 'ZZ', /* Total Anzahl Messages */
/*
2 opt_komma char( 1),
2 opt_event char(51);
*/
if aux.isPutOn then
do;
call putFrame('start','submit_CD99' ,70);
end;
/*
opt_lit1 = 'MESSAGE ';
opt_lit2 = ' VON ';
opt_komma = ',';
opt_event = 'CD_READQUEUER';
opt_totmsg = anzm; /* Total Anzahl Messages */
/*
opt_aktmsg = ii; /* Aktuelle Message Nummer */
pgm = CDPUT3_ptrPgm ;
/* Eingabe vom Bildschirm */
/*
povl_vt01 = pvt01; /* Start für substr(ovl_vt */
/*
totl = 222 /*vt0101*/ ; /* Gesamtlänge */
dtoutl = cstg(dtout);
cdimsstc = '';
/*-----------------------------------------------------------------*/
/*
anzm = totl / dtoutl; /* Anzahl Messages */
/*
if mod(totl, dtoutl) ^= 0 /* auf nächste ganze Zahl */
/*
then anzm = anzm + 1;
*/
/*
outmsg.dtout = 'Hier steht die Struktur für tcd153A1' ;
*/
if ( yCDPUT3k.in.CDPUT3_traceLevel > 1 ) then /* mn@20090824 */
outmsg.isPutOn = '1'b ;
outmsg.processType = $processType ;
outmsg.dtout = tcd153_area ;
if aux.isPutOn then
do;
call putR('** CD99 -Input ' ,70);
call putR('** outmsg.isPutOn . . . : ' ||
outmsg.isPutOn ,70);
call putR('** pgm ptr . . . . . . . : ' ||
pgm->char_20 ,70);
end;
/**--------------------------------**/
/** Change (setup) Message-Queue **/
/**--------------------------------**/
do;
dcl msgtrc char( 8) init('CD99');
/* mn@20070705
%if @compvers = 'EPLI'
%then %do;
call ceetdli(c3,chng,pgm,msgtrc);
%end;
%else %do;
*/
call plitdli(c3,chng,pgm,msgtrc);
/*
%end;
*/
if pgm->tpstc ^= ''
then do;
CDPUT3_rc = 51;
cdimsstc = pgm->tpstc;
@isOk = '0'b;
end;
end;
/**-----------------------------**/
/** Insert into Message-Queue **/
/**-----------------------------**/
if @isOk then
do;
len = 1000 ; /* Maximale Stringlänge */
nso_ppmll = len + 86 ; /* Datenl + Headerl -2 */
nso_ppmz1 = '00000000'b; /* BSMPP normal */
nso_ppmz2 = '00000000'b; /* BSMPP normal */
nso_ppmkommtyp = 'C=01' ; /* Kommunikations-Typ */
nso_ppmabsender = CDPUT3_trxName ; /* Absender-TRC */
nso_ppmhexcode = high(01) ; /* Hexcode-Schutz gegen */
/*
dtout = substr(ovl_vt01,1,len);
povl_vt01 = ptradd(povl_vt01,len);
totl = totl - len;
*/
/* mn@20070705
%if @compvers = 'EPLI'
%then %do;
call ceetdli(c3,isrt,pgm,poutmsg);
%end;
%else %do;
*/
call plitdli(c3,isrt,pgm,poutmsg);
/*
%end;
*/
if pgm->tpstc ^= '' then
do;
CDPUT3_rc = 52;
cdimsstc = pgm->tpstc;
@isOk = '0'b;
end;
end;
/**---------------------------------**/
/** Purge (release) Message-Queue **/
/**---------------------------------**/
if @isOk then
do;
/* mn@20070705
%if @compvers = 'EPLI'
%then %do;
call ceetdli(c2,purg,pgm);
%end;
%else %do;
*/
call plitdli(c2,purg,pgm);
/*
%end;
*/
if pgm->tpstc ^= '' then
do;
CDPUT3_rc = 53;
cdimsstc = pgm->tpstc;
@isOk = '0'b;
end;
end;
endmsgi:
/*
if cdimsstc ^= ''
then do;
if ^aux.isPutOn /* für cdftyp = 'MSGI' */
/*
then call ims_env;
aux.isPutOn = '1'b; /*thb130204*/
/*
cdupp_proc = 'submit_CD99';
cdupp_txt(1) = 'cdimsstc: ' || cdimsstc || '#' ||
', Zieltrc: ' || msgtrc ||
', AbsenderPgm vt0117: ' || vt0117;
call upperro(pycdupp);
end;
*/
if aux.isPutOn then
do;
call putFrame('end ','submit_CD99' ,70);
end;
return( @isOk ) ;
end submit_CD99;
1/**-----------------------------------------------------------------**/
/** 5.38 putIP MDL153 2008-03-07 **/
/**-----------------------------------------------------------------**/
putIP:
proc( $i
, $m )
returns ( char(40)var );
dcl $i bin fixed(31) ;
dcl $m bin fixed(31) ;
dcl @out char (40)var init('') ;
@out = bin31_to_char($i) ||
' (Possible: ' ||
bin31_to_char($m) ||
')' ;
return(@out) ;
end; /* putIP */
/**-----------------------------------------------------------------**/
/** 5.42 getTraceRegionForPid **/
/**-----------------------------------------------------------------**/
getTraceRegionForPid:
proc ( $ptr_gtrfp )
returns ( bit(1)aligned );
dcl $ptr_gtrfp ptr ;
dcl
1 @gtrfp based ( $ptr_gtrfp) ,
3 i ,
5 pid char( 8) ,
3 o ,
5 hasFound bit ( 1)aligned ,
5 getRegion char( 1) ,
5 traceLevel bin fixed(31) ,
5 padd_01 char( 1) ,
3 endOfStruc char( 0) ;
dcl @i bin fixed(31) init(0) ;
dcl @m bin fixed(31) init(0) ;
dcl @isOk bit(1)aligned init('1'b);
call putFrame('start','getTraceRegionForPid' ,70);
call putR ('** input' ,70);
call putR ('** pid . . . : ' ||
@gtrfp.i.pid ,70);
/**------------**/
/** pidStruc **/
/**------------**/
do;
dcl
1 @pidStruc based( addr (tcd152.pid_01) ) ,
3 a(10) ,
5 pid char( 8) ,
5 clientId char(10) ,
5 traceLvl char( 1) ,
5 getRegion char( 1) ,
3 endOfStruc char( 0) ;
@m = hbound(@pidStruc.a,1) ;
do @i=1 to @m
while( @pidStruc.a(@i).pid ^= @gtrfp.i.pid ) ;
end;
if ( @pidStruc.a(@i).pid = @gtrfp.i.pid ) then
do;
@gtrfp.o.hasFound = '1'b ;
@gtrfp.o.getRegion = @pidStruc.a(@i).getRegion ;
@gtrfp.o.traceLevel = Char1_To_Bin31
( @pidStruc.a(@i).traceLvl , 0) ;
end;
else
do;
@gtrfp.o.hasFound = '0'b ;
end;
end;
if ( @gtrfp.o.traceLevel > 0 ) then
do;
aux.isPutOn = '1'b ;
call putR('** trace is switched on by explicit' ||
' userPid' ,70);
call putR('** on TCD152.' ,70);
call putR('** userPid : ' ||
@gtrfp.i.pid ,70);
end;
if ( aux.isPutOn ) then
do;
call putR ('** output' ,70);
call putR ('** hasFound . : ' ||
@gtrfp.o.hasFound ,70);
call putR ('** getRegion : ' ||
@gtrfp.o.getRegion ,70);
call putR ('** traceLevel : ' ||
bin31_to_char(@gtrfp.o.traceLevel) ,70);
call putFrame('end ','getTraceRegionForPid' ,70);
end;
return( @isOk );
end getTraceRegionForPid ;
/**-----------------------------------------------------------------**/
/** 5.42 getTraceRegionForClientId **/
/**-----------------------------------------------------------------**/
getTraceRegionForClientId:
proc ( $ptr_gtrfc )
returns ( bit(1)aligned );
dcl $ptr_gtrfc ptr ;
dcl
1 @gtrfc based ( $ptr_gtrfc) ,
3 i ,
5 clientId char(10) ,
3 o ,
5 hasFound bit ( 1)aligned ,
5 getRegion char( 1) ,
5 traceLevel bin fixed(31) ,
5 padd_01 char( 1) ,
3 endOfStruc char( 0) ;
dcl @i bin fixed(31) init(0) ;
dcl @m bin fixed(31) init(0) ;
dcl @isOk bit(1)aligned init('1'b);
call putFrame('start','getTraceRegionForClientId' ,70);
call putR ('** input' ,70);
call putR ('** clientId . : ' ||
@gtrfc.i.clientId ,70);
/**------------**/
/** pidStruc **/
/**------------**/
do;
dcl
1 @pidStruc based( addr (tcd152.pid_01) ) ,
3 a(10) ,
5 pid char( 8) ,
5 clientId char(10) ,
5 traceLvl char( 1) ,
5 getRegion char( 1) ,
3 endOfStruc char( 0) ;
@m = hbound(@pidStruc.a,1) ;
do @i=1 to @m
while( @pidStruc.a(@i).clientId ^= @gtrfc.i.clientId ) ;
end;
if ( @pidStruc.a(@i).clientId = @gtrfc.i.clientId
& @pidStruc.a(@i).clientId ^= '' ) then /* mn@20120913 */
do;
@gtrfc.o.hasFound = '1'b ;
@gtrfc.o.getRegion = @pidStruc.a(@i).getRegion ;
@gtrfc.o.traceLevel = Char1_To_Bin31
( @pidStruc.a(@i).traceLvl , 0) ;
end;
else
do;
@gtrfc.o.hasFound = '0'b ;
end;
end;
if ( @gtrfc.o.traceLevel > 0 ) then
do;
aux.isPutOn = '1'b ;
call putR('** trace is switched on by explicit' ||
' clientId' ,70);
call putR('** on TCD152.' ,70);
call putR('** clientId : ' ||
@gtrfc.i.clientId ,70);
end;
if ( aux.isPutOn ) then
do;
call putR ('** output' ,70);
call putR ('** hasFound . : ' ||
@gtrfc.o.hasFound ,70);
call putR ('** getRegion : ' ||
@gtrfc.o.getRegion ,70);
call putR ('** traceLevel : ' ||
bin31_to_char(@gtrfc.o.traceLevel) ,70);
call putFrame('end ','getTraceRegionForClientId' ,70);
end;
return( @isOk );
end getTraceRegionForClientId ;
1/**-----------------------------------------------------------------**/
/** 5.05 Char_To_Bin31 MDL155 2008-05-16 **/
/**-----------------------------------------------------------------**/
Char_To_Bin31:
proc ( $charVar
, $errorCd )
returns ( bin fixed (31) );
dcl $charVar char ( 5 ) varying ;
dcl $errorCd bin fixed(31) ;
dcl @bin31 bin fixed(31) init( 0 ) ;
dcl @char1 char(1) init( '') ;
dcl @char2 char(2) init( '') ;
/* This function converts char(1) to bin fixed(31) */
/* In case of a conversion error the value of $errorCd */
/* is returned. */
call putFrame('start','Char_To_Bin31' ,80);
call putR('$charVar 1 : ' ||
$charVar ,80);
$charVar = trim ( $charVar ) ;
call putR('$charVar 2 : ' ||
$charVar ,80);
Select ( length($charVar) ) ;
when ( 1 )
do;
@char1 = $charVar ;
@bin31 = Char1_To_Bin31 ( @char1 , $errorCd ) ;
end;
when ( 2 )
do;
@char2 = $charVar ;
@bin31 = Char2_To_Bin31 ( @char2 , $errorCd ) ;
end;
otherwise
do;
@bin31 = $errorCd ;
end;
end; /* Select ( length($charVar) ) */
call putR('@bin31 . : ' ||
@bin31 ,80);
call putFrame('end ','Char_To_Bin31' ,80);
return ( @bin31 ) ;
end ; /* Char_To_Bin31 */
1/**-----------------------------------------------------------------**/
/** 5.05 Char1_To_Bin31 MDL135 2007-08-13 **/
/**-----------------------------------------------------------------**/
Char1_To_Bin31:
proc ( $char1
, $errorCd )
returns ( bin fixed (31) );
dcl $char1 char ( 1 ) ;
dcl @pic1 pic '9' based(addr($char1));
dcl $errorCd bin fixed(31) ;
dcl @bin31 bin fixed(31) init(0) ;
/* This function converts char(1) to bin fixed(31) */
/* In case of a conversion error the value of $errorCd */
/* is returned. */
on conversion
begin;
@bin31 = $errorCd ;
goto ende;
end; /* conversion */
@bin31 = @pic1 ;
revert conversion ;
ende:
return ( @bin31 ) ;
end ; /* Char1_To_Bin31 */
1/**-----------------------------------------------------------------**/
/** 5.05 Char2_To_Bin31 MDL151 2008-05-16 **/
/**-----------------------------------------------------------------**/
Char2_To_Bin31:
proc ( $Char2
, $errorCd )
returns ( bin fixed (31) );
dcl $Char2 char ( 2 ) ;
dcl @picz9 pic'Z9' based (addr($Char2)) ;
dcl $errorCd bin fixed(31) ;
dcl @bin31 bin fixed(31) init(0) ;
/* This function converts char(1) to bin fixed(31) */
/* In case of a conversion error the value of $errorCd */
/* is returned. */
on conversion
begin;
@bin31 = $errorCd ;
goto ende;
end; /* conversion */
@bin31 = @picz9 ;
revert conversion ;
ende:
return ( @bin31 ) ;
end ; /* Char2_To_Bin31 */
1/**-----------------------------------------------------------------**/
/** 5.07 TraceLevel1TimeDifference_Ok MDL152 2008-09-17 **/
/**-----------------------------------------------------------------**/
TraceLevel1TimeDifference_Ok:
proc ( $point
, $prevTs
, $traceLevel )
returns ( bit(1) aligned );
dcl $point char( 25 ) ;
dcl $prevTs char( 26 ) ;
dcl $traceLevel bin fixed(31) ;
dcl @puts bit(1) aligned init('0'b);
dcl
1 @prevPic based(addr($prevTs)) ,
3 yyyy pic'9999' ,
3 mo pic '99' ,
3 dd pic '99' ,
3 hh pic '99' ,
3 mm pic '99' ,
3 ss pic '99' ,
3 ttt pic '999' ;
dcl @actTs char( 17 ) ;
dcl
1 @actPic based(addr(@actTs)) ,
3 yyyy pic'9999' ,
3 mo pic '99' ,
3 dd pic '99' ,
3 hh pic '99' ,
3 mm pic '99' ,
3 ss pic '99' ,
3 ttt pic '999' ;
dcl @difference char( 12 ) init('00:00:00:000') ;
dcl
1 @diffPic based(addr(@difference)) ,
3 hh pic '99' ,
3 fill_hh char(1) ,
3 mm pic '99' ,
3 fill_mm char(1) ,
3 ss pic '99' ,
3 fill_ss char(1) ,
3 ttt pic '999' ;
/**-------------------**/
/** Trace-Level = 1 **/
/**-------------------**/
if ( $traceLevel = 1 ) then
do;
@puts = aux.isPutOn ;
aux.isPutOn = '1'b ;
if ( $prevTs = '' ) then
do;
$prevTs = dateTime ;
call putM ('*' ,70);
call putR ('**' ,70);
call putR ('** Trace-Level 1' ,70);
call putR ('** =============' ,70);
call putR ('** Point TimeDifference' ,70);
call putR ('** ----- --------------' ,70);
call putR ('** Start ' ,70);
end;
do;
@actTs = dateTime ;
/** Thousendths of Seconds **/
/** ---------------------- **/
do;
if ( @actPic.ttt - @prevPic.ttt >= 0 ) then
do;
@diffPic.ttt = @actPic.ttt - @prevPic.ttt ;
end;
else
do;
@diffPic.ttt = 1000 + @actPic.ttt - @prevPic.ttt ;
@prevPic.ss = @prevPic.ss + 1 ;
end;
end;
/** Seconds **/
/** ------- **/
do;
if ( @actPic.ss - @prevPic.ss >= 0 ) then
do;
@diffPic.ss = @actPic.ss - @prevPic.ss ;
end;
else
do;
@diffPic.ss = 60 + @actPic.ss - @prevPic.ss ;
@prevPic.mm = @prevPic.mm + 1 ;
end;
end;
/** Minutes **/
/** ------- **/
do;
if ( @actPic.mm - @prevPic.mm >= 0 ) then
do;
@diffPic.mm = @actPic.mm - @prevPic.mm ;
end;
else
do;
@diffPic.mm = 60 + @actPic.mm - @prevPic.mm ;
@prevPic.hh = @prevPic.hh + 1 ;
end;
end;
/** Hours **/
/** ----- **/
do;
if ( @actPic.hh - @prevPic.hh >= 0 ) then
do;
@diffPic.hh = @actPic.hh - @prevPic.hh ;
end;
else
do;
@diffPic.hh = 60 + @actPic.hh - @prevPic.hh ;
@prevPic.dd = @prevPic.dd + 1 ;
end;
end;
call putR ('** ' || $point || @difference ,70);
$prevTs = @actTs ;
end;
aux.isPutOn = @puts ;
end;
return('1'b);
end /* TraceLevel1TimeDifference_Ok */ ;
/**-----------------------------------------------------------------**/
/** 5.42 processType_1 **/
/**-----------------------------------------------------------------**/
processType_1:
proc
returns ( bit(1)aligned );
dcl @isOk bit(1)aligned init('1'b);
call putFrame('start','processType_1' ,70);
/**-------------------**/
/** Initialization **/
/**-------------------**/
do;
out.CDPUT3_rc = 0 ;
out.CDPUT3_traceLevel = 0 ;
out.CDPUT3_fillTcd153 = 'N' ;
out.CDPUT3_pid(*) = '' ;
out.CDPUT3_inOrExclude = '' ;
out.CDPUT3_clientIdA(*) = '' ;
out.CDPUT3_forApplUse(*) = '' ;
tcd152 = '' ;
end;
/* Am Anfang wegen cdadmin_sysprint */
if plausi_input_fields_ok () then
do;
if set_default_output_values_ok () then
do;
/**------------------------**/
/** getDataFromTCD152_ok **/
/**------------------------**/
dcl 1 @getTcd152 ,
3 i ,
5 dummy char( 0) init('') ,
3 o ,
5 getRegionName char( 1) init('') ,
5 hasFound bit(1)aligned init('') ,
5 padd_01 char( 2) init('') ,
5 end char( 0) init('') ;
if ^getDataFromTCD152_ok (addr(@getTcd152)) then
do;
@isOk = '0'b ;
CDPUT3_rc = 99 ;
end;
else
do;
/**----------------------------**/
/** insert_missing_tcd152_ok **/
/**----------------------------**/
if ^@getTcd152.o.hasFound then
do;
if ^insert_missing_tcd152_ok
( CDPUT3_serviceId
, CDPUT3_interfaceName
, CDPUT3_operationName
, CDPUT3_pgmName
, CDPUT3_trxName
) then
do;
@isOk = '0'b ;
CDPUT3_rc = 99 ;
end;
/**------------------------**/
/** getDataFromTCD152_ok **/
/**------------------------**/
if ^getDataFromTCD152_ok (addr(@getTcd152)) then
do;
@isOk = '0'b ;
CDPUT3_rc = 99 ;
end;
end;
if ( @getTcd152.o.hasFound
& @isOk ) then
do;
/* not necessary. see below |
out.CDPUT3_traceLevel = tcd152.traceLvlAll ;
out.CDPUT3_fillTcd153 = tcd152.getRegionAll ;
*/
/**------------------------**/
/** getTraceRegionForPid **/
/**------------------------**/
dcl
1 @gtrfp ,
3 i ,
5 pid char( 8) init( '' ) ,
3 o ,
5 hasFound bit ( 1)aligned init('0'b) ,
5 getRegion char( 1) init( '' ) ,
5 traceLevel bin fixed(31) init( 0 ) ,
5 padd_01 char( 1) init( '' ) ,
3 endOfStruc char( 0) init( '' ) ;
@gtrfp.i.pid = in.CDPUT3_pid ;
if ^getTraceRegionForPid (addr(@gtrfp)) then
do;
@isOk = '0'b ;
CDPUT3_rc = 99 ;
end;
else
do;
if ( @gtrfp.o.hasFound ) then
do;
call putR('**' ,70);
call putR('** PID found -> ' ||
'no need to check Client-IDs' ,70);
call putR('**' ,70);
out.CDPUT3_traceLevel = @gtrfp.o.traceLevel ;
out.CDPUT3_fillTcd153 = @gtrfp.o.getRegion ;
end;
else
do;
/**-----------------------------**/
/** getTraceRegionForClientId **/
/**-----------------------------**/
dcl
1 @gtrfc ,
3 i ,
5 clientId char(10) init( '' ) ,
3 o ,
5 hasFound bit ( 1)aligned init('0'b) ,
5 getRegion char( 1) init( '' ) ,
5 traceLevel bin fixed(31) init( '' ) ,
5 padd_01 char( 1) init( '' ) ,
3 endOfStruc char( 0) init( '' ) ;
@gtrfc.i.clientId = in.CDPUT3_clientId ;
if ^getTraceRegionForClientId (addr(@gtrfc)) then
do;
@isOk = '0'b ;
CDPUT3_rc = 99 ;
end;
else
do;
if ( @gtrfc.o.hasFound ) then
do;
out.CDPUT3_traceLevel = @gtrfc.o.traceLevel ;
out.CDPUT3_fillTcd153 = @gtrfc.o.getRegion ;
end;
else
do;
out.CDPUT3_traceLevel =
Char1_To_Bin31( tcd152.traceLvlAll , 0) ;
out.CDPUT3_fillTcd153 = tcd152.getRegionAll ;
if ( out.CDPUT3_traceLevel > 0 ) then
do;
aux.isPutOn = '1'b ;
call putR('** trace is switched on by' ||
' type "all"' ,70);
end;
end;
end;
end;
end;
end;
end; /* getDataFromTCD152_ok */
end; /* set_default_output_values_ok */
end; /* plausi_input_fields_ok */
if ( out.CDPUT3_traceLevel = 0 ) then
do;
/**--------------------------------**/
/** getPidClientIdFromTCD150_ok **/
/**--------------------------------**/
if TraceLevel1TimeDifference_Ok
( 'before TCD150'
, aux.ts /* by reference */
, in.CDPUT3_traceLevel
) then;
do; /* getPidClientIdFromTCD150_ok */
dcl 1 @gpcif ,
3 i ,
5 pid char( 8) init('') ,
5 clientId char(10) init('') ,
5 padd_01 char( 2) init('') ,
3 o ,
5 hasFound bit(1)aligned init('') ,
5 padd_01 char( 3) init('') ,
5 traceLevel bin fixed(31) init( 0) ,
5 getRegionName char( 1) init('') ,
5 padd_02 char( 3) init('') ,
5 endOfStruc char( 0) init('') ;
@gpcif.i.pid = in.CDPUT3_pid ;
@gpcif.i.clientId = CDPUT3_clientId ;
if ^getPidClientIdFromTCD150_ok (addr(@gpcif)) then
do;
@isOk = '0'b ;
CDPUT3_rc = 99 ;
end;
else
do;
if ( @gpcif.o.hasFound ) then
do;
call putR('**' ,70);
call putR('** Trace on for all services.' ,70);
call putR('**' ,70);
out.CDPUT3_traceLevel = @gpcif.o.traceLevel ;
out.CDPUT3_fillTcd153 = @gpcif.o.getRegionName ;
end;
end;
end; /* getPidClientIdFromTCD150_ok */
if TraceLevel1TimeDifference_Ok
( 'after TCD150'
, aux.ts /* by reference */
, in.CDPUT3_traceLevel
) then;
end;
call Fill_CDADMIN_from_CDPUT ;
if ( isFlagOn(out.CDPUT3_filltcd153) ) then
do;
if fill_tcd153_struc_ok () then
do;
end; /* fill_tcd153_struc_ok */
if ( yCDPUT3k.CDPUT3_isExpress ) then
do;
if ^submit_CD99 ('1') then @isOk = '0'b ;
end;
end;
dcl @i bin fixed(31) init(0);
if aux.isPutOn then
do;
call putR ('**' ,70);
call putR ('** output' ,70);
call putR ('** rc . . . . . . . : ' ||
bin31_to_char(out.CDPUT3_rc) ,70);
call putR ('** traceLevel . . . : ' ||
bin31_to_char(out.CDPUT3_traceLevel) ,70);
call putR ('** fillTcd153 . . . : ' ||
out.CDPUT3_fillTcd153 ,70);
call putR ('** clientId' ,70);
call putR ('** inOrExclude . . : ' ||
out.CDPUT3_inOrExclude ,70);
call putR ('** clientIdA' ,70);
do @i=1 to 10 while( out.CDPUT3_clientIdA(@i)^='');
call putR ('** ' || putIP(@i,10) ,70);
call putR ('** clientIdA . : ' ||
out.CDPUT3_clientIdA (@i) ,70);
end;
if @i=1 then
do;
call putR ('** none' ,70);
end;
call putR ('** forApplUse' ,70);
do @i=1 to 3;
call putR ('** ' || putIP(@i,3) ,70);
call putR ('** forApplUse . : ' ||
out.CDPUT3_forApplUse(@i) ,70);
end;
call putR ('** CDADMIN' ,70);
call putR ('** traceLevel . . : ' ||
bin31_to_char(cdadmin_traceLevel) ,70);
call putFrame('end ','processType_1' ,70);
end;
return( @isOk );
end processType_1 ;
1/**-----------------------------------------------------------------**/
/** 5.40 isFlagOn MDL184 2010-05-07 **/
/**-----------------------------------------------------------------**/
isFlagOn:
proc ( $char_1 )
returns( bit(1) );
dcl $char_1 char(1) ;
if ( $char_1 = 'Y'
| $char_1 = 'y'
| $char_1 = 'J'
| $char_1 = 'j' ) then
do;
return('1'b);
end;
else
do;
return('0'b);
end;
end /* isFlagOn */ ;
/**-----------------------------------------------------------------**/
/** 5.42 processType_3 **/
/**-----------------------------------------------------------------**/
processType_3:
proc returns( bit(1)aligned );
dcl @isOk bit(1)aligned init('1'b);
if aux.isPutOn then
do;
call putFrame('start','processType_3' ,70);
end;
/* Am Anfang wegen cdadmin_sysprint */
if plausi_input_fields_ok () then
do;
call putR ('** fillTcd153 : ' ||
in.CDPUT3_filltcd153 ,70);
if ( isFlagOn(in.CDPUT3_filltcd153) ) then
do;
if fill_tcd153_struc_ok () then
do;
end; /* fill_tcd153_struc_ok */
if ( yCDPUT3k.CDPUT3_isExpress ) then
do;
if ^submit_CD99 ('3') then @isOk = '0'b ;
end;
else
do;
if ^submit_CD99 ('4') then @isOk = '0'b ;
end;
end;
end;
if aux.isPutOn then
do;
call putFrame('end ','processType_3' ,70);
end;
return ( @isOk ) ;
end processType_3 ;
/**-----------------------------------------------------------------**/
/** 5.42 processType_2 **/
/**-----------------------------------------------------------------**/
processType_2:
proc
returns ( bit(1)aligned ) ;
dcl @isOk bit(1)aligned init('1'b);
/* Am Anfang wegen cdadmin_sysprint */
if plausi_input_fields_ok () then
do;
/* darf nicht ausgeführt werden.
applUse wird überschrieben.
if set_default_output_values_ok () then
do; */
if (in.CDPUT3_ptrCdadmin = null()) then
do;
yCDPUT3k.out.CDPUT3_traceLevelModule = 0 ;
end;
else
do;
dcl
1 @itofpn ,
3 i ,
5 traceLevelMainPgm bin fixed(31) init('') ,
5 moduleName char(8) init('') ,
3 o ,
5 traceLevel bin fixed(31) init( 0) ,
3 endOfStruc char(0) init('') ;
@itofpn.i.traceLevelMainPgm = cdadmin_traceLevel ;
@itofpn.i.moduleName = CDPUT3_pgmName ;
if ( getTraceLevelForPgmName_ok(addr( @itofpn ))) then
do;
yCDPUT3k.out.CDPUT3_traceLevelModule = @itofpn.o.traceLevel ;
end;
else
do;
yCDPUT3k.out.CDPUT3_traceLevelModule = 0 ;
end;
end;
/*
end; /* set_default_output_values_ok */
end; /* plausi_input_fields_ok */
dcl @i bin fixed(31) init(0);
if aux.isPutOn then
do;
call putR ('**' ,70);
call putR ('** output for ' || @itofpn.i.moduleName ,70);
call putR ('** rc . . . . : ' ||
bin31_to_char(out.CDPUT3_rc) ,70);
call putR ('** traceLevel : ' ||
bin31_to_char(out.CDPUT3_traceLevelModule) ,70);
end;
return ( @isOk );
end processType_2 ;
1/**-----------------------------------------------------------------**/
/** **/
/** 6.0 M a i n - L o g i c **/
/** **/
/**-----------------------------------------------------------------**/
if ( yCDPUT3k.in.CDPUT3_traceLevel > 1 ) then
aux.isPutOn = '1'b ;
else
aux.isPutOn = '0'b ;
if isHeading_ok ( 'YCDPUT3 '
, in.CDPUT3_pid ) then
do;
select ( CDPUT3_processType ) ;
when ( '1' ) /* Top-Module */
do;
if processType_1() then ;
end;
when ( '2' ) /* Sub-Module */
do;
if processType_2() then ;
end;
when ( '3' ) /* Top-Module duration schreiben */
do;
if processType_3() then ;
end;
otherwise
do;
/* kann leer sein. */
end;
end; /* select */
end;
call Footing ( 'YCDPUT3' ) ; /* pgmName */
end yCDPUT3;
}¢--- A540769.WK.PLB(QZDIT02) cre=2014-07-07 mod=2014-07-07-20.43.48 A540769 ---
*process RULES(LAXSEMI); /* suppress semicolon-warning */
*process RULES(BYNAME) ; /* allow "by name" */
*process RULES(NOLAXIF); /* suppress conversion in boolean expression */
/********************************************************************/
/* */
/* testprogram fuer yDIT002 sql 128 */
/* */
/********************************************************************/
qzdit02: Proc($parm) options(main);
%include pgmanfa;
dcl $parm char(80) varying;
-/**-----------------------------------------------------------------**/
/** 1.02 Files **/
/**-----------------------------------------------------------------**/
dcl Sysprint file print output ;
-/**-----------------------------------------------------------------**/
/** 1.03 Datuemer **/
/**-----------------------------------------------------------------**/
dcl 1 inpV static ,
5 invV2 char(9000)
init(( '02USD '
|| '010236'
|| '012991'
|| '012220'
|| '011664'
|| '011234'
|| '010945'
|| '010947'
|| '011235'
|| '012221'
|| '011665'
|| '012992'
|| '010237'
|| '02UYI '
|| '02ADP '
|| '02AED '
|| '02UYN '
|| '010238'
|| '012993'
|| '011666'
|| '012222'
|| '011236'
|| '010949'
|| '010950'
|| '011237'
|| '012223'
|| '011667'
|| '012994'
|| '010239'
|| '02UYU '
|| '02AFA '
|| '02AFN '
|| '02UZS '
|| '010241'
|| '012995'
|| '011668'
|| '012224'
|| '011238'
|| '010952'
|| '010953'
|| '011239'
|| '012225'
|| '011669'
|| '012996'
|| '010242'
|| '02VEB '
|| '02ALK '
|| '02ALL '
|| '02VEF '
|| '010248'
|| '012997'
|| '011670'
|| '012226'
|| '011240'
|| '010955'
|| '010956'
|| '011241'
|| '012237'
|| '011671'
|| '012998'
|| '010249'
|| '02VNC '
|| '02AMD '
|| '02ANG '
|| '02VND '
|| '010251'
|| '013000'
|| '011672'
|| '012238'
|| '011242'
|| '010957'
|| '010958'
|| '011243'
|| '012240'
|| '011673'
|| '013001'
|| '010260'
|| '02VUV '
|| '02AOA '
|| '02AOK '
|| '02WST '
|| '010261'
|| '013002'
|| '011674'
|| '012241'
|| '011244'
|| '010959'
|| '010960'
|| '011245'
|| '012242'
|| '011675'
|| '013003'
|| '010265'
|| '02XAF '
|| '02AON '
|| '02AOR '
|| '02XAF '
|| '010267'
|| '013004'
|| '011676'
|| '012243'
|| '011246'
|| '010961'
|| '010962'
|| '011247'
|| '012244'
|| '011677'
|| '013005'
|| '010275'
|| '02XAF '
|| '02ARP '
|| '02ARS '
|| '02XAG '
|| '010280'
|| '013006'
|| '011678'
|| '012245'
|| '011248'
|| '010963'
|| '010964'
|| '011249'
|| '012246'
|| '011679'
|| '013008'
|| '010285'
|| '02XAU '
|| '02ATS '
|| '02AUD '
|| '02XBA '
|| '010290'
|| '013015'
|| '011680'
|| '012257'
|| '011250'
|| '010965'
|| '010966'
|| '011251'
|| '012258'
|| '011681'
|| '013016'
|| '010292'
|| '02XCD '
|| '02AWG '
|| '02AZM '
|| '02XDR '
|| '010295'
|| '013017'
|| '011682'
|| '012260'
|| '011252'
|| '010967'
|| '010968'
|| '011253'
|| '012261'
|| '011683'
|| '013090'
|| '010305'
|| '02XFO '
|| '02AZN '
|| '02BAD '
|| '02XOF '
|| '010306'
|| '013100'
|| '011684'
|| '012262'
|| '011254'
|| '010969'
|| '010970'
|| '011260'
|| '012263'
|| '011685'
|| '013101'
|| '010307'
|| '02XOF '
|| '02BAM '
|| '02BBD '
|| '02XOF '
|| '010310'
|| '013105'
|| '011686'
|| '012264'
|| '011261'
|| '010971'
|| '010972'
|| '011262'
|| '012270'
|| '011687'
|| '013106'
|| '010311'
|| '02XOF '
|| '02BDT '
|| '02BEC '
|| '02XOF '
|| '010312'
|| '013110'
|| '011688'
|| '012271'
|| '011263'
|| '010973'
|| '010974'
|| '011264'
|| '012272'
|| '011689'
|| '013111'
|| '010315'
|| '02XOF '
|| '02BEF '
|| '02BGJ '
|| '02XOF '
|| '010320'
|| '013115'
|| '011690'
|| '012273'
|| '011270'
|| '010975'
|| '010976'
|| '011290'
|| '012274'
|| '011691'
|| '013120'
|| '010325'
|| '02XPD '
|| '02BGK '
|| '02BGL '
|| '02XPF '
|| '010331'
|| '013121'
|| '011692'
|| '012280'
|| '011291'
|| '010977'
|| '010978'
|| '011292'
|| '012281'
|| '011693'
|| '013125'
|| '010332'
|| '02XPT '
|| '02BGN '
|| '02BHD '
|| '02XZN '
|| '010335'
|| '013130'
|| '011694'
|| '012282'
|| '011301'
|| '010979'
|| '010980'
|| '011302'
|| '012283'
|| '011695'
|| '013210'
|| '010336'
|| '02YDD '
|| '02BIF '
|| '02BMD '
|| '02YER '
|| '010337'
|| '013211'
|| '011696'
|| '012284'
|| '011309'
|| '010981'
|| '010982'
|| '011310'
|| '012285'
|| '011697'
|| '013215'
|| '010338'
|| '02YUD '
|| '02BND '
|| '02BOB '
|| '02YUM '
|| '010340'
|| '013220'
|| '012286'
|| '011698'
|| '011311'
|| '010983'
|| '010984'
|| '011312'
|| '011699'
|| '012297'
|| '013221'
|| '010345'
|| '02YUN '
|| '02BOP '
|| '02BOV '
|| '02ZAR '
|| '010350'
|| '013300'
|| '012298'
|| '011700'
|| '011313'
|| '010985'
|| '010986'
|| '011315'
|| '011701'
|| '012300'
|| '013301'
|| '010355'
|| '02ZMK '
|| '02BRB '
|| '02BRL '
|| '02ZMW '
|| '010357'
|| '013302'
|| '012301'
|| '011702'
|| '011320'
|| '010987'
|| '010988'
|| '011321'
|| '011703'
|| '012302'
|| '013310'
|| '010358'
|| '02ZRN '
|| '02BRN '
|| '02BSD '
|| '02ZRZ '
|| '010360'
|| '013320'
|| '012303'
|| '011704'
|| '011322'
|| '010989'
|| '010990'
|| '011323'
|| '011705'
|| '012304'
|| '013330'
|| '010365'
|| '02ZWC '
|| '02BTN '
|| '02BWP '
|| '02ZWD '
|| '010370'
|| '013331'
|| '012305'
|| '011706'
|| '011330'
|| '010991'
|| '010992'
|| '011331'
|| '011707'
|| '012306'
|| '013400'
|| '010375'
|| '02ZWL '
|| '02BYB '
|| '02BYR '
|| '02ZWN '
|| '010380'
|| '013409'
|| '012313'
|| '011708'
|| '011332'
|| '010993'
|| '010994'
|| '011333'
|| '011709'
|| '012317'
|| '013410'
|| '010385'
|| '010001'
|| '02BZD '
|| '02CAD '
|| '010002'
|| '010390'
|| '013412'
|| '012318'
|| '011710'
|| '011398'
|| '010995'
|| '010996'
|| '011399'
|| '011711'
|| '012320'
|| '013510'
|| '010395'
|| '010003'
|| '02CDF '
|| '02CHF '
|| '010004'
|| '010400'
|| '013511'
|| '012321'
|| '011712'
|| '011400'
|| '010997'
|| '010998'
|| '011401'
|| '011713'
|| '012322'
|| '013550'
|| '010402'
|| '010005'
|| '02CLF '
|| '02CLP '
|| '010006'
|| '010405'
|| '013711'
|| '012323'
|| '011714'
|| '011402'
|| '010999'
|| '011001'
|| '011403'
|| '011715'
|| '012324'
|| '013860'
|| '010415'
|| '010007'
|| '02CNH '
|| '02CNX '
|| '010008'
|| '010420'
|| '013980'
|| '012329'
|| '011716'
|| '011410'
|| '011002'
|| '011003'
|| '011411'
|| '011717'
|| '012330'
|| '013981'
|| '010425'
|| '010009'
|| '02CNY '
|| '02COP '
|| '010010'
|| '010427'
|| '013990'
|| '012331'
|| '011718'
|| '011412'
|| '011010'
|| '011011'
|| '011413'
|| '011719'
|| '012332'
|| '014001'
|| '010430'
|| '010011'
|| '02COU '
|| '02CRC '
|| '010012'
|| '010435'
|| '014002'
|| '012333'
|| '011720'
|| '011450'
|| '011012'
|| '011013'
|| '011451'
|| '011721'
|| '012334'
|| '014010'
|| '010438'
|| '010013'
|| '02CSJ '
|| '02CUC '
|| '010014'
|| '010439'
|| '014011'
|| '012335'
|| '011722'
|| '011452'
|| '011014'
|| '011018'
|| '011500'
|| '011723'
|| '012336'
|| '014020'
|| '010440'
|| '010015'
|| '02CUP '
|| '02CVE '
|| '010016'
|| '010441'
|| '014021'
|| '012343'
|| '011724'
|| '011501'
|| '011019'
|| '011020'
|| '011502'
|| '011725'
|| '012347'
|| '014099'
|| '010442'
|| '010017'
|| '02CYP '
|| '02CZK '
|| '010018'
|| '010443'
|| '014100'
|| '012348'
|| '011726'
|| '011503'
|| '011021'
|| '011025'
|| '011504'
|| '011727'
|| '012350'
|| '014101'
|| '010445'
|| '010019'
|| '02DDM '
|| '02DEM '
|| '010020'
|| '010447'
|| '014106'
|| '012360'
|| '011728'
|| '011505'
|| '011026'
|| '011027'
|| '011506'
|| '011729'
|| '012361'
|| '014110'
|| '010448'
|| '010021'
|| '02DJF '
|| '02DKK '
|| '010022'
|| '010455'
|| '014111'
|| '012362'
|| '011730'
|| '011507'
|| '011028'
|| '011029'
|| '011508'
|| '011731'
|| '012363'
|| '010456'
|| '010023'
|| '02DOP '
|| '014112'
|| '014113'
|| '02DZD '
|| '010024'
|| '010457'
|| '012364'
|| '011732'
|| '011509'
|| '011030'
|| '011031'
|| '011510'
|| '011733'
|| '012365'
|| '010458'
|| '010025'
|| '02ECS '
|| '014115'
|| '014120'
|| '02EEK '
|| '010026'
|| '010459'
|| '012383'
|| '011734'
|| '011511'
|| '011032'
|| '011035'
|| '011512'
|| '011735'
|| '012384'
|| '010460'
|| '010027'
|| '02EGP '
|| '014121'
|| '014125'
|| '02ERN '
|| '010028'
|| '010502'
|| '012390'
|| '011736'
|| '011513'
|| '011036'
|| '011040'
|| '011514'
|| '011737'
|| '012391'
|| '010504'
|| '010029'
|| '02ESA '
|| '014130'
|| '014209'
|| '02ESB '
|| '010030'
|| '010505'
|| '012392'
|| '011738'
|| '011515'
|| '011041'
|| '011042'
|| '011516'
|| '011739'
|| '012393'
|| '010506'
|| '010031'
|| '02ESP '
|| '014211'
|| '014212'
|| '02ETB '
|| '010032'
|| '010507'
|| '012397'
|| '011740'
|| '011517'
|| '011043'
|| '011044'
|| '011518'
|| '011741'
|| '012398'
|| '010508'
|| '010033'
|| '02EUR '
|| '014215'
|| '014225'
|| '02FIM '
|| '010034'
|| '010509'
|| '012399'
|| '011742'
|| '011519'
|| '011045'
|| '011046'
|| '011520'
|| '011743'
|| '012405'
|| '010510'
|| '010035'
|| '02FJD '
|| '014230'
|| '014231'
|| '02FKP '
|| '010036'
|| '010511'
|| '012410'
|| '011744'
|| '011521'
|| '011049'
|| '011051'
|| '011522'
|| '011745'
|| '012422'
|| '010513'
|| '010037'
|| '02FRF '
|| '014232'
|| '014233'
|| '02GBP '
|| '010038'
|| '010517'
|| '012423'
|| '011746'
|| '011523'
|| '011052'
|| '011053'
|| '011524'
|| '011747'
|| '012497'
|| '010518'
|| '010039'
|| '02GEL '
|| '014235'
|| '014236'
|| '02GGP '
|| '010040'
|| '010525'
|| '012498'
|| '011748'
|| '011525'
|| '011054'
|| '011055'
|| '011526'
|| '011749'
|| '012499'
|| '010529'
|| '010041'
|| '02GHC '
|| '014237'
|| '014238'
|| '02GHS '
|| '010042'
|| '010533'
|| '012500'
|| '011750'
|| '011527'
|| '011061'
|| '011062'
|| '011528'
|| '011751'
|| '012501'
|| '010537'
|| '010043'
|| '02GIP '
|| '014400'
|| '014510'
|| '02GMD '
|| '010044'
|| '010541'
|| '012502'
|| '011752'
|| '011529'
|| '011063'
|| '011064'
|| '011530'
|| '011753'
|| '012503'
|| '010549'
|| '010045'
|| '02GNF '
|| '014511'
|| '014550'
|| '02GQE '
|| '010046'
|| '010553'
|| '012504'
|| '011754'
|| '011531'
|| '011065'
|| '011069'
|| '011532'
|| '011755'
|| '012505'
|| '010557'
|| '010047'
|| '02GRD '
|| '014551'
|| '014590'
|| '02GTQ '
|| '010048'
|| '010558'
|| '012509'
|| '011756'
|| '011533'
|| '011070'
|| '011071'
|| '011534'
|| '011757'
|| '012510'
|| '010561'
|| '010049'
|| '02GYD '
|| '014702'
|| '014703'
|| '02HKD '
|| '010050'
|| '010563'
|| '012511'
|| '011758'
|| '011535'
|| '011072'
|| '011073'
|| '011536'
|| '011759'
|| '012512'
|| '010565'
|| '010051'
|| '02HNL '
|| '014721'
|| '014730'
|| '02HRD '
|| '010052'
|| '010567'
|| '012513'
|| '011760'
|| '011537'
|| '011074'
|| '011075'
|| '011538'
|| '011761'
|| '012518'
|| '010569'
|| '010053'
|| '02HRK '
|| '014740'
|| '014750'
|| '02HTG '
|| '010055'
|| '010573'
|| '012521'
|| '011762'
|| '011539'
|| '011076'
|| '011077'
|| '011540'
|| '011763'
|| '012522'
|| '010585'
|| '010056'
|| '02HUF '
|| '014751'
|| '014755'
|| '02IDR '
|| '010057'
|| '010589'
|| '012523'
|| '011764'
|| '011541'
|| '011078'
|| '011079'
|| '011542'
|| '011765'
|| '012529'
|| '010593'
|| '010058'
|| '02IEP '
|| '014756'
|| '014790'
|| '02ILP '
|| '010060'
|| '010595'
|| '012530'
|| '011766'
|| '011543'
|| '011080'
|| '011081'
|| '011544'
|| '011767'
|| '012531'
|| '010597'
|| '010061'
|| '02ILR '
|| '014800'
|| '014900'
|| '02ILS '
|| '010062'
|| '010601'
|| '012532'
|| '011768'
|| '011545'
|| '011082'
|| '011083'
|| '011546'
|| '011769'
|| '012533'
|| '010605'
|| '010064'
|| '02INR '
|| '014901'
|| '014902'
|| '02IQD '
|| '010065'
|| '010606'
|| '012541'
|| '011770'
|| '011547'
|| '011084'
|| '011085'
|| '011548'
|| '011771'
|| '012545'
|| '010609'
|| '010066'
|| '02IRR '
|| '014903'
|| '014904'
|| '02ISJ '
|| '010069'
|| '010613'
|| '012546'
|| '011772'
|| '011549'
|| '011086'
|| '011087'
|| '011550'
|| '011773'
|| '012555'
|| '010617'
|| '010070'
|| '02ISK '
|| '014905'
|| '014906'
|| '02ITL '
|| '010073'
|| '010618'
|| '012559'
|| '011774'
|| '011551'
|| '011088'
|| '011090'
|| '011552'
|| '011775'
|| '012560'
|| '010619'
|| '010074'
|| '02JMD '
|| '014950'
|| '014951'
|| '02JOD '
|| '010075'
|| '010625'
|| '012561'
|| '011776'
|| '011553'
|| '011091'
|| '011092'
|| '011554'
|| '011777'
|| '012562'
|| '010641'
|| '010082'
|| '02JPY '
|| '014952'
|| '014953'
|| '02KES '
|| '010083'
|| '010642'
|| '012563'
|| '011778'
|| '011555'
|| '011093'
|| '011094'
|| '011556'
|| '011779'
|| '012564'
|| '010645'
|| '010084'
|| '02KGS '
|| '014954'
|| '014955'
|| '02KHR '
|| '010087'
|| '010646'
|| '012569'
|| '011780'
|| '011557'
|| '011095'
|| '011096'
|| '011558'
|| '011781'
|| '012570'
|| '010647'
|| '010088'
|| '02KMF '
|| '015910'
|| '015911'
|| '02KPW '
|| '010089'
|| '010649'
|| '012571'
|| '011782'
|| '011559'
|| '011097'
|| '011098'
|| '011560'
|| '011783'
|| '012572'
|| '010653'
|| '010090'
|| '02KRW '
|| '015912'
|| '015914'
|| '02KWD '
|| '010091'
|| '010657'
|| '012573'
|| '011784'
|| '011561'
|| '011100'
|| '011101'
|| '011562'
|| '011785'
|| '012580'
|| '010661'
|| '010093'
|| '02KYD '
|| '015918'
|| '015919'
|| '02KZT '
|| '010094'
|| '010671'
|| '012581'
|| '011786'
|| '011563'
|| '011102'
|| '011103'
|| '011564'
|| '011787'
|| '012582'
|| '010672'
|| '010095'
|| '02LAJ '
|| '015921'
|| '015922'
|| '02LAK '
|| '010096'
|| '010673'
|| '012583'
|| '011788'
|| '011565'
|| '011104'
|| '011105'
|| '011566'
|| '011789'
|| '012601'
|| '010674'
|| '010097'
|| '02LBP '
|| '015923'
|| '015924'
|| '02LKR '
|| '010098'
|| '010675'
|| '012605'
|| '011790'
|| '011567'
|| '011106'
|| '011107'
|| '011568'
|| '011791'
|| '012606'
|| '010677'
|| '010099'
|| '02LRD '
|| '015925'
|| '015926'
|| '02LSL '
|| '010101'
|| '010678'
|| '012607'
|| '011792'
|| '011569'
|| '011108'
|| '011109'
|| '011570'
|| '011793'
|| '012608'
|| '010679'
|| '010102'
|| '02LSM '
|| '015927'
|| '015928'
|| '02LTL '
|| '010104'
|| '010681'
|| '012609'
|| '011794'
|| '011571'
|| '011110'
|| '011111'
|| '011572'
|| '011795'
|| '012610'
|| '010685'
|| '010105'
|| '02LUF '
|| '015929'
|| '015930'
|| '02LVL '
|| '010106'
|| '010689'
|| '012611'
|| '011796'
|| '011573'
|| '011112'
|| '011113'
|| '011574'
|| '011797'
|| '012612'
|| '010697'
|| '010107'
|| '02LYD '
|| '015931'
|| '015932'
|| '02MAD '
|| '010108'
|| '010700'
|| '012613'
|| '011798'
|| '011575'
|| '011114'
|| '011115'
|| '011576'
|| '011799'
|| '012625'
|| '010701'
|| '010109'
|| '02MAL '
|| '019001'
|| '019002'
|| '02MCU '
|| '010110'
|| '010703'
|| '012626'
|| '012000'
|| '011577'
|| '011116'
|| '011118'
|| '011578'
|| '012001'
|| '012627'
|| '010704'
|| '010111'
|| '02MDL '
|| '019003'
|| '019004'
|| '02MGA '
|| '010112'
|| '010705'
|| '012631'
|| '012002'
|| '011579'
|| '011119'
|| '011120'
|| '011580'
|| '012003'
|| '012632'
|| '010706'
|| '010113'
|| '02MGF '
|| '019005'
|| '019006'
|| '02MKD '
|| '010116'
|| '010707'
|| '012633'
|| '012010'
|| '011581'
|| '011125'
|| '011126'
|| '011582'
|| '012011'
|| '012634'
|| '010708'
|| '010117'
|| '02MMK '
|| '019011'
|| '019012'
|| '02MNI '
|| '010118'
|| '010710'
|| '012640'
|| '012014'
|| '011583'
|| '011127'
|| '011128'
|| '011584'
|| '012015'
|| '012641'
|| '010755'
|| '010119'
|| '02MNT '
|| '019015'
|| '019025'
|| '02MOP '
|| '010120'
|| '010760'
|| '012642'
|| '012016'
|| '011585'
|| '011130'
|| '011131'
|| '011586'
|| '012017'
|| '012643'
|| '010768'
|| '010122'
|| '02MPB '
|| '019030'
|| '019035'
|| '02MRO '
|| '010123'
|| '010769'
|| '012661'
|| '012020'
|| '011587'
|| '011132'
|| '011133'
|| '011588'
|| '012021'
|| '012662'
|| '010770'
|| '010124'
|| '02MSN '
|| '019040'
|| '019050'
|| '02MTL '
|| '010125'
|| '010771'
|| '012663'
|| '012025'
|| '011589'
|| '011134'
|| '011140'
|| '011590'
|| '012026'
|| '012664'
|| '010772'
|| '010126'
|| '02MTP '
|| '019080'
|| '019090'
|| '02MUR '
|| '010127'
|| '010775'
|| '012665'
|| '012028'
|| '011591'
|| '011141'
|| '011149'
|| '011592'
|| '012029'
|| '012666'
|| '010780'
|| '010129'
|| '02MVQ '
|| '019999'
|| '02MVR '
|| '010130'
|| '010781'
|| '012667'
|| '012030'
|| '011593'
|| '011150'
|| '011151'
|| '011594'
|| '012031'
|| '012668'
|| '010782'
|| '010132'
|| '02MWK '
|| '02MXN '
|| '010133'
|| '010783'
|| '012669'
|| '012033'
|| '011595'
|| '011152'
|| '011153'
|| '011596'
|| '012040'
|| '012680'
|| '010784'
|| '010135'
|| '02MXP '
|| '02MXV '
|| '010136'
|| '010785'
|| '012681'
|| '012041'
|| '011597'
|| '011154'
|| '011155'
|| '011598'
|| '012042'
|| '012682'
|| '010790'
|| '010138'
|| '02MYR '
|| '02MZE '
|| '010139'
|| '012684'
|| '012043'
|| '011599'
|| '011156'
|| '010805'
|| '010809'
|| '011157'
|| '011600'
|| '012045'
|| '012685'
|| '010141'
|| '02MZM '
|| '02MZN '
|| '010142'
|| '012686'
|| '012046'
|| '011601'
|| '011158'
|| '010811'
|| '010813'
|| '011160'
|| '011602'
|| '012047'
|| '012687'
|| '010143'
|| '02NAD '
|| '02NGN '
|| '010144'
|| '012690'
|| '012048'
|| '011603'
|| '011161'
|| '010817'
|| '010821'
|| '011162'
|| '011604'
|| '012050'
|| '012691'
|| '010145'
|| '02NIC '
|| '02NIO '
|| '010146'
|| '012695'
|| '012051'
|| '011605'
|| '011163'
|| '010823'
|| '010825'
|| '011164'
|| '011606'
|| '012052'
|| '012696'
|| '010147'
|| '02NLG '
|| '02NOK '
|| '010150'
|| '012713'
|| '012053'
|| '011607'
|| '011165'
|| '010829'
|| '010833'
|| '011166'
|| '011608'
|| '012054'
|| '012714'
|| '010151'
|| '02NPR '
|| '02NZD '
|| '010152'
|| '012715'
|| '012055'
|| '011609'
|| '011167'
|| '010837'
|| '010840'
|| '011168'
|| '011610'
|| '012056'
|| '012717'
|| '010153'
|| '02OMR '
|| '02PAB '
|| '010154'
|| '012730'
|| '012057'
|| '011611'
|| '011169'
|| '010841'
|| '010842'
|| '011170'
|| '011612'
|| '012060'
|| '012731'
|| '010156'
|| '02PEN '
|| '02PES '
|| '010157'
|| '012740'
|| '012061'
|| '011613'
|| '011177'
|| '010843'
|| '010844'
|| '011178'
|| '011614'
|| '012062'
|| '012750'
|| '010158'
|| '02PGK '
|| '02PHP '
|| '010161'
|| '012751'
|| '012063'
|| '011615'
|| '011179'
|| '010845'
|| '010849'
|| '011180'
|| '011616'
|| '012064'
|| '012758'
|| '010162'
|| '02PKR '
|| '02PLN '
|| '010163'
|| '012759'
|| '012065'
|| '011617'
|| '011181'
|| '010857'
|| '010870'
|| '011182'
|| '011618'
|| '012066'
|| '012760'
|| '010164'
|| '02PTE '
|| '02PYG '
|| '010165'
|| '012773'
|| '012067'
|| '011619'
|| '011183'
|| '010871'
|| '010872'
|| '011184'
|| '011620'
|| '012068'
|| '012780'
|| '010166'
|| '02QAR '
|| '02ROL '
|| '010167'
|| '012785'
|| '012069'
|| '011621'
|| '011185'
|| '010873'
|| '010874'
|| '011186'
|| '011622'
|| '012070'
|| '012790'
|| '010168'
|| '02RON '
|| '02RSD '
|| '010169'
|| '012800'
|| '012071'
|| '011623'
|| '011187'
|| '010877'
|| '010878'
|| '011188'
|| '011624'
|| '012072'
|| '012801'
|| '010170'
|| '02RUB '
|| '02RUR '
|| '010171'
|| '012802'
|| '012073'
|| '011625'
|| '011189'
|| '010879'
|| '010880'
|| '011190'
|| '011626'
|| '012074'
|| '012803'
|| '010172'
|| '02RWF '
|| '02SAR '
|| '010173'
|| '012804'
|| '012075'
|| '011627'
|| '011191'
|| '010881'
|| '010882'
|| '011192'
|| '011628'
|| '012076'
|| '012806'
|| '010174'
|| '02SBD '
|| '02SCR '
|| '010175'
|| '012807'
|| '012077'
|| '011629'
|| '011195'
|| '010883'
|| '010884'
|| '011196'
|| '011630'
|| '012078'
|| '012820'
|| '010176'
|| '02SDD '
|| '02SDG '
|| '010177'
|| '012821'
|| '012079'
|| '011631'
|| '011197'
|| '010885'
|| '010886'
|| '011632'
|| '011198'
|| '012080'
|| '012822'
|| '010178'
|| '02SDP '
|| '02SEK '
|| '010179'
|| '012823'
|| '012081'
|| '011200'
));
dcl 1 inp based(addr(inpV)),
5 ele (1500),
10 d2 char(2) ,
10 d5 char(4) ;
dcl 1 WHERE,
5 W1 char( 8) INIT('20140707') ,
5 W2 char( 2) ,
5 W4 char( 8) INIT('20140707') ,
5 W5 char(20) ;
dcl 1 fetch,
5 f0 char(20) ,
5 f1 char( 8) ,
5 f2 char( 2) ,
5 f3 char( 2) ,
5 f4 char( 8) ,
5 f5 char(20) ,
5 f6 char(26) ,
5 f7 char( 7) ;
1/**-----------------------------------------------------------------**/
/** 1.5 DB2 Infrastruktur **/
/**-----------------------------------------------------------------**/
exec sql include sqlca;
/* Cursor */
-/**-----------------------------------------------------------------**/
/** 1.6 Strukturen **/
/**-----------------------------------------------------------------**/
dcl
1 aux , /* auxiliary */
3 isPutOn bit(1) aligned init('0'b) ,
3 putFlag(100) char(1) init((100)('')),
3 C_tcd152_open bit(1) aligned init('0'b) ,
3 C_yCDPUT3_open bit(1) aligned init('0'b) ,
3 c_region_open bit(1) aligned init('0'b) ,
3 c_tracePidClientId_open bit(1) aligned init('0'b) ,
3 ts char(26) init( '' ),
3 t bin fixed(31,0) init( 0 ) , /* tabulator */
3 p_9 pic'9' init( 0 ) ;
-/**-----------------------------------------------------------------**/
/** 1.7 Uebrige Deklarationen **/
/**-----------------------------------------------------------------**/
dcl ( addr
, binary
, cstg
, datetime
, hbound
, high
, length
, max
, min
, mod
, null
, pliRetv
, ptradd
, string
, substr
, sysnull
, translate
, trim
, verify ) builtin;
/* db cursor (dynamic sql) sql */
exec sql declare c1 cursor for s1;
/* counters decl */
dcl 1 cnt
, 5 fnd bin fixed(31) init(0)
, 5 noF bin fixed(31) init(0)
, 5 cnt bin fixed(31) init(0)
, 5 sel bin fixed(31) init(0)
, 5 ins bin fixed(31) init(0)
, 5 write_ddout bin fixed(31) init(0)
, 5 errors bin fixed(31) init(0)
, 5 commit_counter bin fixed(31) init(0)
, 5 tst char(26) init('')
, 5 fun char(1) init('')
;
dcl (cx, iMax, ix, iy) fixed(31) bin;
dcl res bit(1);
/*_____________________________________________________________________
main */
/* inits */
put ('start of qzDit02') skip;
put (' parm=' || trim($parm) || ' len=' || length($parm)) skip;
call sql_connect();
put ('connected') skip;
iMax = 1000;
do cx=1 to length($parm);
fun = substr($parm, cx, 1);
if fun = 'h' then do;
iMax = 100000;
end;
else if fun = 'O' | fun = 'F' then do;
do ix=1 to iMax;
iy = mod(ix, 1500) + 1;
/* put (''|| iY ||' d2='|| d2(iY) ||' d5='|| d5(iY)) skip; */
w2 = d2(iY);
w5 = d5(iY);
if fun = 'O' then
res = sqlOrig();
else if fun = 'F' then
res = sqlFetFir();
if res then do;
/* put('found f0=' || f0 ||' f1='|| f1 ||' f2='|| f2
||' f3=' || f3 ||' f4='|| f4 ||' f5='|| f5) skip;*/
fnd = fnd + 1;
end;
else do;
/* put('not found') skip; */
noF = noF + 1;
end;
end;
put ('fun='|| fun || ': ' || iMax || ': '
|| fnd || ' found and ' || noF || ' not') skip;
end;
else if fun <> ' ' then do;
put ('bad fun='|| fun ) skip;
end;
end;
return;
if substr($parm, 1, 1) = 'A' then
call doA(substr($parm, 2, 1));
else if substr($parm, 1, 1) = 'B' then
call doB;
else do;
put (' no test ') skip;
cnt.tst = '';
cnt.sel = 123;
cnt.tst = 'sel = ' || edit(sel, '9999') || ' und schluss';
put (' sel=123: ', cnt.tst) skip;
exec sql
select current timestamp into :cnt.tst
from sysibm.sysDummy1
;
put ('sql code: ', sqlCode) skip;
if sqlCode <> 0 THEN
call sqlMsg;
put ('selected current timestamp: ', cnt.tst) skip;
end;
RETURN;
/*_____________________________________________________________________
subroutines */
sqlOrig: proc returns(bit(1));
exec sql
SELECT DI00200, DI00201, DI00202, DI00203, DI00204, DI00205,
DI00206, DI00207
INTO :F0, :F1, :F2, :F3, :F4, :F5, :F6, :F7
FROM oa1p.VDI002A1A A WHERE
DI00201 <= :W1 AND DI00201 = ( SELECT MAX ( DI00201 ) FROM
VDI002A1A WHERE DI00201 <= :W1 AND DI00202 = A.DI00202
AND DI00203 = A.DI00203 AND DI00204 >= :W4 AND DI00205 =
A.DI00205 ) AND DI00202 = :W2 AND DI00203 = ' ' AND
DI00204 >= :W4 AND DI00205 = :W5
fetch first 1 row only
;
if sqlCode = 0 then
return('1'b);
if sqlCode <> 100 then
call sqlErr(sourceLine(), 'sqlOrig select into');
return ('0'b);
end sqlOrig;
sqlFetFir: proc returns(bit(1));
exec sql
SELECT DI00200, DI00201, DI00202, DI00203, DI00204, DI00205,
DI00206, DI00207
INTO :F0, :F1, :F2, :F3, :F4, :F5, :F6, :F7
from oa1p.VDI002A1A A
WHERE DI00201 <= :w1
AND DI00202 = :w2 AND DI00203 = ' '
AND DI00204 >= :w4 AND DI00205 = :w5
order by di00201 desc
fetch first 1 row only
;
if sqlCode = 0 then
return('1'b);
if sqlCode <> 100 then
call sqlErr(sourceLine(), 'sqlFetFir select into');
return ('0'b);
end sqlFetFir;
doA:proc($f);
dcl $f char(1);
dcl (ix, jx) bin fixed(31) init(0);
dcl (pa, fo)char(3);
dcl uu char(36);
dcl tx char(10000) varying;
do jx=1 to 5;
do ix=1 to 10000;
pa = edit(1 + mod(ix, 5), '999');
uu = 'uuid' || edit(ix, '9999') || '=uuid';
fo = 'for';
tx = copy('p=' || pa || ' uuid=' || uu || ' fo=' || fo
|| '... ', 40);
/* if $f = '1' then
call doV1(pa, uu, fo, tx);
else if $f = '2' then
call doV2(pa, uu, fo, tx);
else if $f = '3' then
call doV3(pa, uu, fo, tx);
*/ end;
end;
call sql_commit;
put ('commit after ' || trim(edit(cnt.cnt, 'zzzzzz9'))
|| ' ' || $f || ': ' || cnt.fun) skip;
end doA;
doB:proc();
end doB;
/*
sql connect__________________________________________________________*/
%include yxrrsaf;
sql_connect:proc();
dcl ssid char(04) init('DBOF');
dcl plan char(08) init('QZTEST');
if yxrrsaf('CONNECT',ssid,plan) ^= 0 then
put('qzDit02'
,'Error in YXRRSAF Call'
,'SSID - '||ssid
,'PLAN - '||plan) skip;
end sql_connect;
/*
commit_______________________________________________________________*/
sql_commit: proc();
if yxrrsaf('COMMIT') ^= 0 then
put('qzDit02'
,'Error in YXRRSAF Commit Call');
end sql_commit;
sql_rollback: proc();
if yxrrsaf('ROLLBACK') ^= 0 then
put('qzDit02'
,'Error in YXRRSAF ROLLBACK Call');
end sql_rollback;
DCL DSNTIAR ENTRY EXTERNAL OPTIONS(ASM INTER RETCODE);
sqlMsg: proc ();
DCL MSGWIDTH FIXED BIN(31) INIT(72);
DCL MSGBLEN FIXED BIN(15) INIT(20); /* MAX # SQL MESSAGES */
DCL i FIXED BIN(31) INIT(0);
DCL 01 MESSAGE /* MESSAGE RETURN BUFFER */
, 02 MESSAGEL FIXED BIN(15) INIT(1440) /* BUFFER LENGTH */
, 02 MESSAGET(MSGBLEN) CHAR(msgWidth) INIT((*)' ') /* TEXT */
;
/* NOW PRINT OUT SQL STATEMENT RESULTS VIA DSNTIAR */
CALL DSNTIAR(SQLCA,MESSAGE,MSGWIDTH);
IF PLIRETV ^= 0 THEN DO; /* IF THE RETURN CODE ISN'T ZERO@08*/
/* ISSUE AN ERROR MESSAGE @08*/
PUT EDIT (' RETURN CODE ', PLIRETV, /* @08*/
' FROM MESSAGE ROUTINE DSNTIAR.') /* @08*/
(COL(1), A(13), F(8), A(30)); /* ISSUE THE MESSAGE @08*/
END; /* END ISSUE AN ERROR MESSAGE @08*/
DO I = 1 TO MSGBLEN /* @08*/
WHILE (MESSAGET(I) ^= ''); /* @08*/
PUT EDIT ( MESSAGET(I) ) (COL(1), A(msgWIdth)); /* @08*/
END; /* @08*/
end SqlMsg;
sqlErr: proc (lNo, txt);
DCL lNo FIXED BIN(31);
dcl txt char(500) varying;
put ('error at ' || trim(edit(lNo, 'ZZZZZZZZZ9'))
|| ': ' || txt) skip;
call sqlMsg;
call sql_rollback;
put ('error signal error') skip;
signal error;
end sqlErr;
end QZDIT02;
}¢--- A540769.WK.PLB(QZNZGFM) cre= mod=-. --------------------------------------
*process default(connected);
qznzgfm: proc($parm) options(main);
/*_____________________________________________________________________
declarationS */
%include pgmanfa; /* On Error */
dcl $parm char(80) varying;
/* printer file */
dcl sysprint file print;
/* sqlca struc */
exec sql include sqlca;
exec sql include sqlDA;
dcl spaceSQLDA char(2000) init ('');
/* db cursor (dynamic sql) sql */
exec sql declare c1 cursor for s1;
/* counters decl */
dcl 1 cnt
, 5 cnt bin fixed(31) init(0)
, 5 sel bin fixed(31) init(0)
, 5 prp bin fixed(31) init(0)
, 5 fet bin fixed(31) init(0)
, 5 fet1 bin fixed(31) init(0)
, 5 ins bin fixed(31) init(0)
, 5 com bin fixed(31) init(0)
, 5 write_ddout bin fixed(31) init(0)
, 5 errors bin fixed(31) init(0)
, 5 commit_counter bin fixed(31) init(0)
, 5 tst char(26) init('')
, 5 fun char(126) varying init('')
;
dcl ix bin fixed(31) init(0);
dcl kMax bin fixed(31) init(0);
dcl 1 srvPool(6) static nonAsgn
, 2 poolSrv char(8) init( 'SIC'
, 'CHECK'
, 'GFM'
, 'SWIFT'
, 'TELEX'
, 'SICI'
)
, 2 poolView char(9) init( 'VNZ100A1V'
, 'VNZ101A1V'
, 'VNZ106A1V'
, 'VNZ111A1V'
, 'VNZ113A1V'
, 'VNZ118A1V'
)
;
dcl 1 io
, 5 iSrv char(8) init('GFM')
, 5 iOrd char(30) init('10801407221400040')
, 5 iRun char( 5) init('00001')
, 5 jOrd char(32) init('10801407221400040')
, 5 jRun char( 7) init('00001')
, 5 oMsgNo bin fixed(31) init(0)
, 5 oMsg char(3000) var init('')
;
DCL KEYSRZ2 CHAR(32720) INIT( ( /* ?????????? */
/* RZ2 2014-07-28-07.52.17 */
'3XS80140714800016300001'
|| '21000140709140014400001'
|| '33D00140626800748700001'
|| '13D00140715800002600001'
|| '33D30140618800017000001'
|| '53M80100929800012800010'
|| '33D60140630800189200001'
|| '43N60140702800246300010'
|| '33F00140725800008100001'
|| '23N00140702800418700001'
|| '33MX0140723800000300001'
|| '13N00140303800997500001'
|| '33N00140514800017700001'
|| '53D80101221801236800010'
|| '33N10140322800235200001'
|| '43N50140126800819500010'
|| '33N20131128800442600001'
|| '23F30140724800003800001'
|| '33N20140525800072500001'
|| '13N30140111800042200001'
|| '33N30140313800135300001'
|| '51020081027140070800010'
|| '33N30140723800020300001'
|| '43N30140719800066300010'
|| '33N40140529800022700001'
|| '23S80140703800012200001'
|| '33N50140118800606300001'
|| '13N50140503800321300001'
|| '33N50140521800087300001'
|| '53S50081205800017000010'
|| '33N60140308800050400001'
|| '43N10140721800294900010'
|| '33N70131229800055800001'
|| '23M80140707800058300001'
|| '33N80130903802567500001'
|| '13N80140310800285200001'
|| '33N80140324801016100001'
|| '53N80080813801375300010'
|| '33N80140710800001500001'
|| '43N00140519800154300010'
|| '33S20140723800000100001'
|| '23F20140722800000300001'
|| '33S60140617800019400001'
|| '1900014072280002730000A'
|| '34B40140728800000100001'
|| '53M80120113800030000010'
|| '31080140704140062400001'
|| '43F10140718800007600010'
|| '33D20140707800265800001'
|| '23S50140708800024900001'
|| '33D50140709800135600001'
|| '13F30140725800004600001'
|| '33D80140715801604600001'
|| '53M80080731800080900010'
|| '33I40140728800000100001'
|| '43D60140724800467400010'
|| '33N00140323800214900001'
|| '23M20140710800000200001'
|| '33N10131215800329100001'
|| '13N20140408800751400001'
|| '33N10140713800000700001'
|| '51060081106140062500010'
|| '33N20140422800115700001'
|| '43D20140726800042500010'
|| '33N30140111800042200001'
|| '23F20140707800008200001'
|| '33N30140628800014800001'
|| '13N50131211801365900001'
|| '33N40140429800214000001'
|| '53S80080725800009700010'
|| '33N50131211801365900001'
|| '41070140724140261800010'
|| '33N50140426800675000001'
|| '23S20140718800002000001'
|| '33N60131226800052100001'
|| '13N70140711800006700001'
|| '33N60140715800001700001'
|| '53S10081224800007300010'
|| '33N70140708800006000001'
|| '43VD0140707800000900010'
|| '33N80140225800043800001'
|| '23F80140716800020500001'
|| '33N80140615800032800001'
|| '13S50140714800003600002'
|| '33S10140725800000300001'
|| '53M90101220800001400010'
|| '33S50140701800122300001'
|| '43S10140728800001600010'
|| '33S80140724800005100001'
|| '23F10140724800020300001'
|| '31050140711140028300001'
|| '13D60140707800036200001'
|| '33D10140719800006800001'
|| '53M80091030800046600010'
|| '33D40140724800070300001'
|| '43N80140706800095000010'
|| '33D80140613802768400001'
|| '23S10140709800011900001'
|| '33F80140718800098800001'
|| '13N10140626800021600001'
|| '33N00131218800353900001'
|| '53D50080721802117100010'
|| '33N00140706800005700001'
|| '43N70140624800215400010'
|| '33N10140618800137800001'
|| '23F80140703800025000001'
|| '33N20140308800238000001'
|| '13N40140417800512800001'
|| '33N20140718800000100001'
|| '51010080929140489100010'
|| '33N30140603800236900001'
|| '43N50140710800553400010'
|| '33N40140314800461000001'
|| '23F10140708800019000001'
|| '33N40140721800000300001'
|| '13N60140709800006500001'
|| '33N50140327800542500001'
|| '53S50080905800014400010'
|| '33N50140713800006200001'
|| '43N40140706800088500002'
|| '33N60140620800026100001'
|| '23N80140716800717900001'
|| '33N70140613800049300001'
|| '13S20140612800062200003'
|| '33N80140121802815300001'
|| '53N80080623800990700010'
|| '33N80140521800220600001'
|| '43N20140714800268000010'
|| '33S00140722800003600001'
|| '23F70140723800005200001'
|| '33S40140721800006900001'
|| '13D30140610800081000001'
|| '33S80140619800164400001'
|| '53M80110830800011500010'
|| '31020140722140064000001'
|| '43N00140721800077800010'
|| '33D00140726800000100001'
|| '23F00140722800002000001'
|| '33D40140606800386100001'
|| '13N00140705800002800001'
|| '33D70140627800116900001'
|| '53M20100811800016200010'
|| '33F50140708800003300001'
|| '43F80140724800004900010'
|| '33M60140725800000500008'
|| '23N80140630801947400001'
|| '33N00140611800013100001'
|| '13N30140609800104100001'
|| '33N10140522800197100001'
|| '51040081126140241000010'
|| '33N20140125800577900001'
|| '43D80140716803833100010'
|| '33N20140623800018300001'
|| '23F60140709800008600001'
|| '33N30140503800131600001'
|| '13N50140724800001500001'
|| '33N40140115800147000001'
|| '53S70081014800004600010'
|| '33N40140626800001100001'
|| '43D40140727800005100010'
|| '33N50140224800165300001'
|| '23F00140707800009400001'
|| '33N50140618800011300001'
|| '13N80140608800017200001'
|| '33N60140524800021300001'
|| '53S00080818800019500010'
|| '33N70140508800174600001'
|| '43D00140724800081400010'
|| '33N80131219802641000001'
|| '23N50140629803389700001'
|| '33N80140426800084100001'
|| '11080140726140001300001'
|| '33Q40140725800000100001'
|| '53M80121206800119300010'
|| '33S30140725800000100001'
|| '41000140723140018600010'
|| '33S70140704800029300001'
|| '23F50140721800004700001'
|| '31000140711140018200001'
|| '13N00131015800345100001'
|| '33D00140629800079000001'
|| '53M80090327800098600010'
|| '33D30140630800247200001'
|| '43S50140728800001000010'
|| '33D60140705800006200001'
|| '23D80140708800313900001'
|| '33F10140714800005400001'
|| '13N20140715800002100001'
|| '33M00140702800000300003'
|| '51080081223140433800010'
|| '33N00140517800212600001'
|| '43N80140723800229800010'
|| '33N10140328800149500001'
|| '23N20140721800187400001'
|| '33N20131209800221300001'
|| '13N50140331801341600001'
|| '33N20140528800095400001'
|| '53VG0120612800029900010'
|| '33N30140318800108400001'
|| '43N70140727800001600010'
|| '33N30140726800000200001'
|| '23F40140725800001500001'
|| '33N40140601800087600001'
|| '13N80140203801333000001'
|| '33N50140122800212000001'
|| '53S50080609800036100010'
|| '33N50140524800031000001'
|| '43N50140727800017200010'
|| '33N60140316800023900001'
|| '21060140709140008800001'
|| '33N70140116800025800001'
|| '13S80140710800029800002'
|| '33N80131012800653700001'
|| '53N50080929801367100010'
|| '33N80140327802657800001'
|| '43N40140726800004200010'
|| '33N80140713800002300001'
|| '23N00140721800280100001'
|| '33S20140728800000100001'
|| '13D80140724800341600001'
|| '33S60140701800066500001'
|| '53M80110203800070400010'
|| '34B70140725803543800001'
|| '43N30140710800071200010'
|| '31080140710140107000001'
|| '23F40140704800024900001'
|| '33D20140710800389500001'
|| '13N20140222800246000001'
|| '33D50140712800084500001'
|| '53F00120822800020300010'
|| '33D80140718800004100001'
|| '43N10140715800022800010'
|| '33I70140726800000100001'
|| '23S80140717800009300001'
|| '33N00140327800317200001'
|| '13N40140716800004200001'
|| '33N10131228800014500001'
|| '51030081027140045900010'
|| '33N10140716800005900001'
|| '43M80140725800001200010'
|| '33N20140427800456800001'
|| '23M80140718800025800001'
|| '33N30140121800213100001'
|| '13N70140613800049300001'
|| '33N30140701800032300001'
|| '53S60081016800001600010'
|| '33N40140502800221600001'
|| '43F00140724800024400002'
|| '33N50131216800152200001'
|| '23F30140707800001100001'
|| '33N50140429800964300001'
|| '13S50140303800184200002'
|| '33N60131230800121400001'
|| '53N80081122800988400010'
|| '33N60140718800003500001'
|| '43D60140716800233200010'
|| '33N70140711800006700001'
|| '23S60140721800004400001'
|| '33N80140228801474100001'
|| '13D50140711800724000001'
|| '33N80140618800062500001'
|| '53M80120613800065900010'
|| '33S20140612800062200001'
|| '43D20140722800046000002'
|| '33S50140704800049700001'
|| '23M50140702800006600001'
|| '33T00140728800000100000'
|| '13N10140528800031300001'
|| '31050140721140097300001'
|| '53M80081029800028800010'
|| '33D10140722800141500001'
|| '41050140725140070300010'
|| '33D40140727800000100001'
|| '23F20140714800004600001'
|| '33D80140622800082800001'
|| '13N40140206800461100001'
|| '33F80140723800032900001'
|| '51080080829140231300010'
|| '33N00131226800284800001'
|| '43S80140725800005600002'
|| '33N00140709800000100001'
|| '23S40140703800003900001'
|| '33N10140621800002100001'
|| '13N60140611800004200001'
|| '33N20140312800297300001'
|| '53S80081202800001400010'
|| '33N20140721800004000001'
|| '43S00140723800023400010'
|| '33N30140606800076100001'
|| '23F80140724800005500001'
|| '33N40140322800290400001'
|| '13S00140718800003000002'
|| '33N40140724800004000001'
|| '53S30080714800013700010'
|| '33N50140330800203400001'
|| '43N80140701800715200010'
|| '33N50140716800022500001'
|| '23F20140630800051000001'
|| '33N60140623800053200001'
|| '13D20140701803986300001'
|| '33N70140616800332700001'
|| '53N30100504800060200010'
|| '33N80140126800874200001'
|| '43N60140725800008200010'
|| '33N80140524800176900001'
|| '23S20140703800007300001'
|| '33S00140725800000200001'
|| '13N00140607800081000001'
|| '33S40140724800000900001'
|| '53M80101006800129000010'
|| '33S80140625800128800001'
|| '43N50140704800178900010'
|| '31020140725140033700003'
|| '23F80140710800042200001'
|| '33D10140528800319800001'
|| '13N30140508800369200001'
|| '33D40140702800186600001'
|| '53D80110712803453000010'
|| '33D70140705800025300001'
|| '43N40140605800114800002'
|| '33F50140715800006700001'
|| '23F10140718800000300001'
|| '33M80140709800005300001'
|| '13N50140626800007700001'
|| '33N00140614800051500001'
|| '51020081103140077400010'
|| '33N10140526800228300001'
|| '43N20140704800595000010'
|| '33N20140131800296900001'
|| '23S00140716800011700001'
|| '33N20140626800003800001'
|| '13N80140511800470500001'
|| '33N30140508800369200001'
|| '53S50081217800017700010'
|| '33N40140121800101200001'
|| '43N00140716800135700010'
|| '33N40140629800027600001'
|| '23F80140627800069100001'
|| '33N50140227800804000001'
|| '11050140725140213100001'
|| '33N50140621800055300001'
|| '53N80080816800541100010'
|| '33N60140528800000100001'
|| '43F80140715800129500010'
|| '33N70140518800109400001'
|| '23F10140630800028400001'
|| '33N80131224801327600001'
|| '13M40140724800004300001'
|| '33N80140429803612600001'
|| '53M80120126800069500010'
|| '33Q70140725800000100001'
|| '43D80140710800801400010'
|| '33S40140422800062500001'
|| '23N80140709800631400001'
|| '33S70140710800020000001'
|| '13N20140617800117700001'
|| '31000140718140012800001'
|| '53M80080804800001500010'
|| '33D00140703802306700001'
|| '43D40140723800773300010'
|| '33D30140705800004000001'
|| '23F70140703800005900001'
|| '33D60140709800050700001'
|| '13N50140225800245900001'
|| '33F10140722800019500001'
|| '51060081205140034900010'
|| '33M00140725800001100008'
|| '43D00140719800025300010'
|| '33N00140520800348100001'
|| '23F00140716800002900001'
|| '33N10140403800293800001'
|| '13N80131227802226800001'
|| '33N20131215800203100001'
|| '53S80080808800039800010'
|| '33N20140601800236800001'
|| '44WF0140724800002500010'
|| '33N30140324800374800001'
|| '23N50140718800297000001'
|| '33N40130828800425600001'
|| '13S70140723800000900002'
|| '33N40140604800116500001'
|| '53S10100201800013600010'
|| '33N50140125800030900001'
|| '43S50140711800020900010'
|| '33N50140527800163800001'
|| '23F60140701800006500001'
|| '33N60140327800450500001'
|| '13D80140626802563000001'
|| '33N70140209800117500001'
|| '53M90111018800001000010'
|| '33N80131027804528200001'
|| '43N80140719800008200010'
|| '33N80140330800335000001'
|| '23F00140626800021700001'
|| '33N80140716800000300001'
|| '13N20131227800519000001'
|| '33S30140520800036300001'
|| '53M80091127800055100010'
|| '33S60140705800001100001'
|| '43N70140723800024300013'
|| '34B70140728800000100001'
|| '23N40140716800041100001'
|| '31080140718140074300001'
|| '13N40140618800180500001'
|| '33D20140714800056300001'
|| '53D50080811800579300010'
|| '33D50140715800171800001'
|| '43N50140723800006800010'
|| '33D80140721800958800001'
|| '23F50140708800002400001'
|| '33I80140726800000100001'
|| '13N70140501800279200001'
|| '33N00140401800126100001'
|| '51010080930140035500010'
|| '33N10140109800339400001'
|| '43N40140722800041600010'
|| '33N10140719800002700001'
|| '23D50140702801641100001'
|| '33N20140501800434500001'
|| '13S40140501800045900002'
|| '33N30140126800586300001'
|| '53S50080908800022800010'
|| '33N30140704800009300001'
|| '43N20140727800009900010'
|| '33N40140505800044000001'
|| '23N20140701800314400001'
|| '33N50131220801647500001'
|| '13D40140723800000100001'
|| '33N50140502800917900001'
|| '53N80080625802239800010'
|| '33N60140112800238200001'
|| '43N10140706800241700010'
|| '33N60140721800006700001'
|| '23F40140716800012400001'
|| '33N70140714800013600001'
|| '13N10140326800225600001'
|| '33N80140303800439100001'
|| '53M80110929800118800010'
|| '33N80140621800032600001'
|| '43M20140725800004800002'
|| '33S20140625800050800005'
|| '21000140710140014400001'
|| '33S50140708800012900001'
|| '13N40131126800963900001'
|| '33VD0140704800000800001'
|| '53M20110308800001600010'
|| '31050140724140068200001'
|| '43D81140723800312900010'
|| '33D10140725800005200001'
|| '23N00140710800152200001'
|| '33D50140605803259800001'
|| '13N60140429800044000001'
|| '33D80140626802563000001'
|| '51040081204140229700010'
|| '33F80140728800000300001'
|| '43D50140726800040100010'
|| '33N00140109800170500001'
|| '23F30140725800000100001'
|| '33N00140712800002000001'
|| '13P80140725800014000001'
|| '33N10140624800060600001'
|| '53S70081016800005100010'
|| '33N20140322800554100001'
|| '43D10140727800013400010'
|| '33N20140724800001300001'
|| '23S80140709800000200001'
|| '33N30140609800104100001'
|| '13D10140709800364000001'
|| '33N40140327800086500001'
|| '53S00080912800004500010'
|| '33N40140727800000100001'
|| '41040140724140060900010'
|| '33N50140403800926900001'
|| '23M80140708800020400001'
|| '33N50140719800000300001'
|| '13N00140509800163700001'
|| '33N60140626800068700001'
|| '53M80121213800079700010'
|| '33N70140619800047200001'
|| '43S80140721800014700010'
|| '33N80140130801198800001'
|| '23F20140723800000500001'
|| '33N80140527800196300001'
|| '13N30140316800056200001'
|| '33S10140429800061800001'
|| '53M80090401800021200010'
|| '33S50140228800098200001'
|| '43S00140627800000400010'
|| '33S80140630800314600001'
|| '23S50140710800035800001'
|| '31020140728140001000001'
|| '13N50140529800063300001'
|| '33D10140616800056600001'
|| '51080081224141935500010'
|| '33D40140705800015200001'
|| '43N80140625802348700010'
|| '33D70140710800056900001'
|| '23M20140722800003100001'
|| '33F50140722800011900001'
|| '13N80140410800301600001'
|| '33M80140717800012400004'
|| '53VG0121010800107600010'
|| '33N00140617800006500001'
|| '43N60140721800089800010'
|| '33N10140529800047300001'
|| '23F20140708800000200001'
|| '33N20140203800042900001'
|| '11020140717140092800001'
|| '33N20140629800012400001'
|| '53S50080610800017300010'
|| '33N30140511800050200001'
|| '43N50140619800427300010'
|| '33N40140127800337000001'
|| '23S20140723800024200001'
|| '33N40140702800040800001'
|| '13F80140716800069300001'
|| '33N50140302800262200001'
|| '53N50081124800645800010'
|| '33N50140624800017800001'
|| '43N30140727800006900010'
|| '33N60140531800118900001'
|| '23F80140717800018700001'
|| '33N70140523800331500001'
|| '13N20140519800352500001'
|| '33N80131227801735900001'
|| '53M80110214800033500010'
|| '33N80140502802198000001'
|| '43N20140523800446900010'
|| '33S00140625800080700001'
|| '23F10140725800000400001'
|| '33S40140611800045500001'
|| '13N50140120800874300001'
|| '33S70140715800005400001'
|| '53F00121214800050100010'
|| '31000140724140063700001'
|| '43N00140711800461600010'
|| '33D00140706800007900001'
|| '23S10140711800016100001'
|| '33D30140708800057000001'
|| '13N80131013800935700001'
|| '33D60140712800034500001'
|| '51030081107140095800010'
|| '33F10140725800001200001'
|| '43F60140723800005800010'
|| '33M20140718800001400005'
|| '23F80140704800000600001'
|| '33N00140523800097000001'
|| '13S60140716800016500002'
|| '33N10140421800201500001'
|| '53S60081111800012000010'
|| '33N20131221800676700001'
|| '43D70140726800022100010'
|| '33N20140604800006100001'
|| '23F10140709800001400001'
|| '33N30140330800148400001'
|| '13D70140705800025300001'
|| '33N40131121800354100001'
|| '53N80081204801805900010'
|| '33N40140607800017500001'
|| '43D40140716800426200010'
|| '33N50140128801177800001'
|| '23N80140717800505000001'
|| '33N50140530800031800001'
|| '13N10140722800004300001'
|| '33N60140407800175400001'
|| '53M80120618800086200010'
|| '33N70140228800190800001'
|| '43C00140724800378000002'
|| '33N80131101801942900001'
|| '23F70140724800005100001'
|| '33N80140402801226700001'
|| '13N40140520800042500001'
|| '33N80140719800001000001'
|| '53M80081105800098500010'
|| '33S30140627800011100001'
|| '43VD0140725800000400010'
|| '33S60140711800009700001'
|| '23F00140723800001500001'
|| '34WF0140725800003700001'
|| '13N70131217800052200001'
|| '31080140723140278700001'
|| '51080080924143547200010'
|| '33D20140717800000500001'
|| '43S40140716800012700010'
|| '33D50140718800194400001'
|| '23N80140703801458300001'
|| '33D80140724800341600001'
|| '13S30140311800000500002'
|| '33K00140722800004400001'
|| '53S80081204800048200010'
|| '33N00140409800168700001'
|| '43N80140715800365500010'
|| '33N10140116800151500001'
|| '23F60140717800009800001'
|| '33N10140722800004300001'
|| '13D30140725800055400001'
|| '33N20140505800011100001'
|| '53S30081114800001700010'
|| '33N30140203800041000001'
|| '43N70140718800054900010'
|| '33N30140707800012000001'
|| '23F00140709800021800001'
|| '33N40140508800295700001'
|| '13N10131215800329100001'
|| '33N50131224801017600001'
|| '53N30110309800360800010'
|| '33N50140505800480100001'
|| '43N50140719800444800010'
|| '33N60140124800242300001'
|| '23N50140710800022200001'
|| '33N60140724800000200001'
|| '13N30140705800006500001'
|| '33N70140717800005100001'
|| '53M80101007800017900010'
|| '33N80140307800967400001'
|| '43N40140717800448600010'
|| '33N80140624800010300001'
|| '23F50140722800013400001'
|| '33S20140630800143800001'
|| '13N60140206800310500001'
|| '33S50140711800006000001'
|| '53D80110927800241400010'
|| '33VD0140710800000700001'
|| '43N20140723800037300010'
|| '31050140727140024500001'
|| '23D80140714803831600001'
|| '33D10140728800000100001'
|| '13N80140704800001600001'
|| '33D50140617800681600001'
|| '51020081127140100700010'
|| '33D80140629800239900001'
|| '43N10140603800255800010'
|| '33G20140725800000100001'
|| '23N20140722800746900001'
|| '33N00140204800242800001'
|| '13D00140712800017700001'
|| '33N00140715800002000001'
|| '53S50090112800039100010'
|| '33N10140627800014300001'
|| '43K50140728800000400010'
|| '33N20140326800017300001'
|| '23F50140630800007000001'
|| '33N20140727800000100001'
|| '13N00140227801038500001'
|| '33N30140612800004300001'
|| '53N80080822800605100010'
|| '33N40140404800268400001'
|| '43D80140726800133900010'
|| '33N50130912800655200001'
|| '23D00140701802529500001'
|| '33N50140408801017100001'
|| '13N30131226800438700001'
|| '33N50140722800009000001'
|| '53M80120214800102800010'
|| '33N60140629800001900001'
|| '43D50140722801073500010'
|| '33N70140622800008100001'
|| '23N00140723800220400001'
|| '33N80140203801333000001'
|| '13N50140501800792100001'
|| '33N80140530800172500001'
|| '53M80080808800108200010'
|| '33S10140626800049100001'
|| '43D10140722800145800010'
|| '33S50140326800215500001'
|| '23F40140708800004500001'
|| '33S80140703800049900001'
|| '13N80140308800378700001'
|| '31030140721140021900001'
|| '51080080625140155300010'
|| '33D10140628800019900001'
|| '41030140721140021900010'
|| '33D40140708800057800001'
|| '23S80140718800005000001'
|| '33D70140716800149400001'
|| '1900014071780003510000F'
|| '33F60140723800002200001'
|| '53S80080822800141600010'
|| '33M80140722800017400006'
|| '43S70140728800000300010'
|| '33N00140620800019900001'
|| '23M80140722800051800001'
|| '33N10140602800308500001'
|| '13F20140725800013800001'
|| '33N20140209800004900001'
|| '53S20080701800031900010'
|| '33N20140702800006700001'
|| '43P70140725800007500010'
|| '33N30140514800148900001'
|| '23F30140709800000400001'
|| '33N40140202800581600001'
|| '13N20140405800365200001'
|| '33N40140705800005700001'
|| '53N00080805800176100010'
|| '33N50140307801002200001'
|| '43N80140602802218900002'
|| '33N50140627800034400001'
|| '23S80140627800061300001'
|| '33N60140603800085600001'
|| '13N50131207800604600001'
|| '33N70140526800426700001'
|| '53M80100111800037700010'
|| '33N80131230802434400001'
|| '43N60140713800185000010'
|| '33N80140505800290700001'
|| '23M80140627800068300001'
|| '33S00140701800104600001'
|| '13N70140709800013300001'
|| '33S40140623800044600001'
|| '53D50080821801792900010'
|| '33S70140718800003300001'
|| '43N50140529801015800010'
|| '31000140727140000600001'
|| '23F20140716800000400001'
|| '33D00140709800642200001'
|| '13S50140710800017800002'
|| '33D30140712800011700001'
|| '51010081029140371400010'
|| '33D60140715800000500001'
|| '43N30140723800092800010'
|| '33F20140718800019100001'
|| '23S50140701800012900001'
|| '33M30140704800001200003'
|| '13D60140705800006200001'
|| '33N00140526800299600001'
|| '53S50080909800008600010'
|| '33N10140424800415500001'
|| '43N10140725800002100010'
|| '33N20131225800248900001'
|| '23F80140725800004700001'
|| '33N20140607800031800001'
|| '13N10140624800060600001'
|| '33N30140403800409400001'
|| '53N80080626800090700010'
|| '33N40131128800711400001'
|| '43N00140629801058400010'
|| '33N40140610800084700001'
|| '23F20140701800001000001'
|| '33N50140131800040900001'
|| '13N40140415800067600001'
|| '33N50140602800075900001'
|| '53M80111013800070900010'
|| '33N60140421800139900001'
|| '43F40140724800006100010'
|| '33N70140312800337000001'
|| '23S20140704800011800001'
|| '33N80131112800018900001'
|| '13N60140707800010500001'
|| '33N80140408800075400001'
|| '53M20120416800022900010'
|| '33N80140722800006100001'
|| '43D70140717800350400010'
|| '33S30140702800043800001'
|| '23F80140711800002600001'
|| '33S60140716800006700001'
|| '13S10140728800000100001'
|| '34Z20140725800000100002'
|| '51040081223141425800010'
|| '31080140726140001300001'
|| '43D30140724800152300010'
|| '33D20140720800029800001'
|| '23F10140721800020700001'
|| '33D50140721800957700001'
|| '13D30140602800250500001'
|| '33D80140727800000100001'
|| '53S70081022800004700010'
|| '33K20140725800005800003'
|| '41080140725140142000010'
|| '33N00140417800300400001'
|| '23S00140723800018100001'
|| '33N10140202800310500001'
|| '13N00140703800031300001'
|| '33N10140725800000400001'
|| '53S00080930800009900010'
|| '33N20140509800704700001'
|| '43VD0140716800000300010'
|| '33N30140218800255900001'
|| '23F80140630800007200001'
|| '33N30140710800020900001'
|| '13N30140607800020200001'
|| '33N40140512800010800001'
|| '53M80130110800107100010'
|| '33N50131227802024400001'
|| '43S20140728800000200010'
|| '33N50140508800056600001'
|| '23F10140701800003800001'
|| '33N60140129800387700001'
|| '13N50140722800009000001'
|| '33N60140727800000400001'
|| '53M80090415800033500010'
|| '33N70140720800002900001'
|| '43N80140710800442600010'
|| '33N80140310800285200001'
|| '23N80140712800697100001'
|| '33N80140627800053500001'
|| '13N80140606800010800001'
|| '33S20140704800072000001'
|| '51080120228140162700010'
|| '33S50140716800000900001'
|| '43N70140713800099300010'
|| '33VD0140716800000300004'
|| '23F70140707800009100001'
|| '31060140723140021300001'
|| '11080140724140230900001'
|| '33D20140613800955000001'
|| '53VG0130613800073700010'
|| '33D50140623801255200001'
|| '43N50140715800090600010'
|| '33D80140702800539400001'
|| '23F00140717800000400001'
|| '33G50140725800000100001'
|| '13N00131011800439900001'
|| '33N00140217800317500001'
|| '53S50080613800008600010'
|| '33N00140718800000700001'
|| '43N40140710800037400010'
|| '33N10140630800053200001'
|| '23N60140709800046700001'
|| '33N20140331800136600001'
|| '13N20140713800004900001'
|| '33N30131019800073600001'
|| '53N50081202801406200010'
|| '33N30140615800128700001'
|| '43N20140718800519200002'
|| '33N40140412800127700001'
|| '23F60140703800001000001'
|| '33N50131028802143100001'
|| '13N50140329800844200001'
|| '33N50140413800050900001'
|| '53M80110301800042600010'
|| '33N50140725800001200001'
|| '43N00140725800009400010'
|| '33N60140702800027500001'
|| '23F00140630800029600001'
|| '33N70140625800038000001'
|| '13N80140201800346300001'
|| '33N80140206802431900001'
|| '53F00130222800019000010'
|| '33N80140602800047100001'
|| '43K10140726800000100010'
|| '33S10140701800058000001'
|| '23N40140718800254800001'
|| '33S50140527800264100001'
|| '13S80140708800034300002'
|| '33S80140707800062600001'
|| '51030081127140073100010'
|| '31030140725140013700002'
|| '43D80140722802126100010'
|| '33D10140704800316300001'
|| '23F50140709800023500001'
|| '33D40140711800175800001'
|| '13D80140722800166800001'
|| '33D70140719800015600001'
|| '53S60081125800000600010'
|| '33F70140716800006900001'
|| '43D50140712800084600010'
|| '33M80140725800001200003'
|| '23D80140625802588200001'
|| '33N00140623800020500001'
|| '13N20140218800067200001'
|| '33N10140605800063200001'
|| '53N80081210800846700010'
|| '33N20140218800067200001'
|| '43D10140701800067200013'
|| '33N20140705800020400001'
|| '23N20140703800155600001'
|| '33N30140520800113800001'
|| '13N40140714800004500001'
|| '33N40140207800299600001'
|| '53M80120625800118200010'
|| '33N40140708800007900001'
|| '41020140724140091500010'
|| '33N50140310800967700001'
|| '23F40140718800011200001'
|| '33N50140630800110500001'
|| '13N70140611800065300001'
|| '33N60140606800088300001'
|| '53M80081113800118800010'
|| '33N70140530800235300001'
|| '43S60140724800028100070'
|| '33N80140104800296200001'
|| '21000140724140053800001'
|| '33N80140508800260000001'
|| '13S40140728800000500001'
|| '33S00140704800036300001'
|| '51080080925140310300010'
|| '33S40140702800007600001'
|| '43N80140727800021200010'
|| '33S70140723800000900001'
|| '23N00140711800310900001'
|| '31010140714140036600001'
|| '13D50140709800135600001'
|| '33D00140712800017700001'
|| '53S80081222800175800010'
|| '33D30140715800041300001'
|| '43N80140406800926400010'
|| '33D60140718800216900001'
|| '23F40140625800031200001'
|| '33F30140627800003400001'
|| '13N10140526800228300001'
|| '33M40140723800004100017'
|| '53S40080609800012700010'
|| '33N00140529800035200001'
|| '43N60140702800246300010'
|| '33N10140427800041600001'
|| '23S80140714800056000001'
|| '33N20140102800688500001'
|| '13N40140202800581600001'
|| '33N20140610800149300001'
|| '53N30110310800005400010'
|| '33N30140407800450000001'
|| '43N50140126800819500010'
|| '33N40131217800380600001'
|| '23M80140710800038400001'
|| '33N40140613800059400001'
|| '13N60140608800030300001'
|| '33N50140205800395900001'
|| '53M80101008800111600010'
|| '33N50140605800010700001'
|| '43N30140719800066300010'
|| '33N60140428800475800001'
|| '23F20140724800000800001'
|| '33N70140325800080000001'
|| '13S00140716800003500002'
|| '33N80131122800235800001'
|| '53D80120126805906900010'
|| '33N80140411801002800001'
|| '43N10140721800294900010'
|| '33N80140725800002500001'
|| '23S50140717800004800001'
|| '33S30140707800029100001'
|| '13D20140629800110800001'
|| '33S60140721800001500001'
|| '51020081203140089500010'
|| '34Z60140725800000400003'
|| '43N00140519800154300010'
|| '32000100204140011200010'
|| '23M40140626800000100001'
|| '33D20140723800051300001'
|| '13N00140605800188100001'
|| '33D50140724800010700001'
|| '53S50090421800014500010'
|| '33D81140716800152100001'
|| '43F10140718800007600010'
|| '33K40140726800000100001'
|| '23F20140709800001000001'
|| '33N00140422800277600001'
|| '13N30140504800236100001'
|| '33N10140207800133600001'
|| '53N80080826802248800010'
|| '33N10140728800000100001'
|| '43D60140724800467400010'
|| '33N20140512800242500001'
|| '23S20140724800011000001'
|| '33N30140223800084200001'
|| '13N50140624800017800001'
|| '33N30140713800000200001'
|| '53M80120216800036800010'
|| '33N40140518800240900001'
|| '43D20140726800042500010'
|| '33N50140102800533000001'
|| '23F80140721800015800001'
|| '33N50140511800435600001'
|| '13N80140509800619300001'
|| '33N60140207800185500001'
|| '53M80080812800090700010'
|| '33N70131027800163900001'
|| '41070140724140261800010'
|| '33N70140723800006300001'
|| '23F20140625800055400001'
|| '33N80140313800817400001'
|| '11050140723140094300001'
|| '33N80140630800059800001'
|| '51080080626140306000010'
|| '33S20140709800003300001'
|| '43VD0140707800000900010'
|| '33S50140721800006900001'
|| '23S20140627800047400001'
|| '33VD0140724800000100001'
|| '13M30140725800000600001'
|| '31060140726140005300001'
|| '53S80080829800050300010'
|| '33D20140626800489700001'
|| '43S10140728800001600010'
|| '33D50140629800065700001'
|| '23F80140707800013000001'
|| '33D80140705800061300001'
|| '13N20140615800033900001'
|| '33G80140725800000100001'
|| '53S20080729800006400010'
|| '33N00140222800132000001'
|| '43N80140706800095000010'
|| '33N00140721800004500001'
|| '23F10140710800014300001'
|| '33N10140703800027100001'
|| '13N50140223800320700001'
|| '33N20140404800524600001'
|| '53N00080902800120700010'
|| '33N30131122800315600001'
|| '43N70140624800215400010'
|| '33N30140618800018400001'
|| '23N80140722800772200001'
|| '33N40140416800040300001'
|| '13N80131225801137300001'
|| '33N50131115800464900001'
|| '53M80100113800173400010'
|| '33N50140416800580500001'
|| '43N50140710800553400010'
|| '33N50140728800000100001'
|| '23F70140725800000300001'
|| '33N60140705800002000001'
|| '13S70140721800000100002'
|| '33N70140628800006800001'
|| '53D50081125802604800010'
|| '33N80140214800198000001'
|| '43N40140706800088500002'
|| '33N80140605800334500001'
|| '23F00140724800019500001'
|| '33S10140710800026300001'
|| '13D80140623802596000001'
|| '33S50140611800122700001'
|| '51010081030140046000010'
|| '33S80140710800019500001'
|| '43N20140714800268000010'
|| '31030140728140001200001'
|| '23N80140704801722600001'
|| '33D10140708800084600001'
|| '13N20131224800791600001'
|| '33D40140714800429900001'
|| '53S50080910800003700010'
|| '33D70140722800178800001'
|| '43N00140721800077800010'
|| '33F80140624800103300001'
|| '23F60140725800001200001'
|| '33N00131011800439900001'
|| '13N40140616800001800001'
|| '33N00140626800035600001'
|| '53N80080630802435000010'
|| '33N10140608800013900001'
|| '43F80140724800004900010'
|| '33N20140223800510000001'
|| '23F00140711800014400001'
|| '33N20140708800027600001'
|| '13N70140428800233300001'
|| '33N30140524800119400001'
|| '53M80111027800101000010'
|| '33N40140215800047200001'
|| '43D80140716803833100010'
|| '33N40140711800012900001'
|| '23N50140711800627200001'
|| '33N50140316800402800001'
|| '13S40140213800028800002'
|| '33N50140703800003500001'
|| '53M20131205800009500010'
|| '33N60140609800050300001'
|| '43D40140727800005100010'
|| '33N70140602800021800001'
|| '23F50140723800012800001'
|| '33N80140107800050600001'
|| '13D40140721800218000001'
|| '33N80140511800470500001'
|| '51050080701140000900010'
|| '33S00140708800021100001'
|| '43D00140724800081400010'
|| '33S40140705800001200001'
|| '23D80140715803038700001'
|| '33S70140728800000200001'
|| '13N10140322800235200001'
|| '31010140725140027400001'
|| '53S70081111800000400010'
|| '33D00140716800273300001'
|| '41000140723140018600010'
|| '33D30140718800000400001'
|| '23N20140724800615600001'
|| '33D60140721800081100001'
|| '13N40130919800188200001'
|| '33F40140123800009200001'
|| '53S00081010800009000010'
|| '33M50140704800020000004'
|| '43S50140728800001000010'
|| '33N00140601800100500001'
|| '23F50140701800000800001'
|| '33N10140505800157500001'
|| '13N60140427800129100001'
|| '33N20140105800607500001'
|| '53M80130204800116500010'
|| '33N20140613800127200001'
|| '43N80140723800229800010'
|| '33N30140413800017300001'
|| '23D10140707800201200001'
|| '33N40131222800213200001'
|| '13P60140725800014500001'
|| '33N40140616800001800001'
|| '53M80090420800153000010'
|| '33N50140209800165000001'
|| '43N70140727800001600010'
|| '33N50140608800029200001'
|| '23N10140628800154500001'
|| '33N60140504800023600001'
|| '13D10140707800056300001'
|| '33N70140403800397900001'
|| '53D00110515800015500010'
|| '33N80131206801852200001'
|| '43N50140727800017200010'
|| '33N80140414800741300001'
|| '23F40140709800023400001'
|| '33N80140728800000100001'
|| '13N00140507800496600001'
|| '33S30140711800010500001'
|| '53VG0130719800034000010'
|| '33S60140724800003500001'
|| '43N40140726800004200010'
|| '39B80120913800000500000'
|| '23S80140723800046800001'
|| '33C00140723800050200001'
|| '13N30140312800355800001'
|| '33D20140726800000100001'
|| '53S50080624800012100010'
|| '33D50140727800002400001'
|| '43N30140710800071200010'
|| '33D81140724800000100001'
|| '23M80140723800044100001'
|| '33K60140726800000100001'
|| '13N50140527800163800001'
|| '33N00140506800216800001'
|| '53N50100303800099500010'
|| '33N10140221800307400001'
|| '43N10140715800022800010'
|| '33N20130903800767300001'
|| '23F30140718800000200001'
|| '33N20140515800518100001'
|| '13N80140408800075400001'
|| '33N30140227800143900001'
|| '53M80110314800046200010'
|| '33N30140716800006600001'
|| '43M80140725800001200010'
|| '33N40140522800139500001'
|| '23S80140630800006900001'
|| '33N50140106800033900001'
|| '11020140714140043000001'
|| '33N50140514800233900001'
|| '53F10110907800007300010'
|| '33N60140215800033500001'
|| '43F00140724800024400002'
|| '33N70131212800003000001'
|| '23M80140630800038400001'
|| '33N70140726800000100001'
|| '13F80140709800106100001'
|| '33N80140316800504200001'
|| '51030081209140102800010'
|| '33N80140703800035300001'
|| '43D60140716800233200010'
|| '33S20140714800023100001'
|| '23F20140718800012300001'
|| '33S50140724800000700001'
|| '13N20140514800241300001'
|| '33VG0140728800000100001'
|| '53S60081222800006600010'
|| '31070140709140029800001'
|| '43D20140722800046000002'
|| '33D20140629800110800001'
|| '23S50140702800050600001'
|| '33D50140702800370400001'
|| '13N50140117800855500001'
|| '33D80140708801042600001'
|| '53N80081216802065400010'
|| '33I10140725800014800001'
|| '41050140725140070300010'
|| '33N00140226800543900001'
|| '23M20140627800002500001'
|| '33N00140724800002600001'
|| '13N80130929804126800001'
|| '33N10140706800000900001'
|| '53M80120628800082700010'
|| '33N20140408800751400001'
|| '43S80140725800005600002'
|| '33N30131211800144600001'
|| '23F20140702800000800001'
|| '33N30140621800007200001'
|| '13S60140714800000400002'
|| '33N40140421800067000001'
|| '53M80081114800090800010'
|| '33N50131124800182400001'
|| '43S00140723800023400010'
|| '33N50140419800485800001'
|| '23S20140708800032900001'
|| '33N60131125800608900001'
|| '13D70140629800012800001'
|| '33N60140708800010800001'
|| '51080080929142391400010'
|| '33N70140701800024600001'
|| '43N80140701800715200010'
|| '33N80140218800079500001'
|| '23F80140714800026000001'
|| '33N80140608800017200001'
|| '13N10140720800001200001'
|| '33S10140716800002400001'
|| '53S80090122800038200010'
|| '33S50140614800005600001'
|| '43N60140725800008200010'
|| '33S80140715800006900001'
|| '23F10140722800002200001'
|| '31040140724140060900001'
|| '13N40140518800240900001'
|| '33D10140711800176100001'
|| '53S40080610800001200010'
|| '33D40140717800677300001'
|| '43N50140704800178900010'
|| '33D70140725800071500001'
|| '23S10140630800024100001'
|| '33F80140708800011100001'
|| '13N70131212800003000001'
|| '33N00131021800358200001'
|| '53N30110505800025900010'
|| '33N00140629800038900001'
|| '43N40140605800114800002'
|| '33N10140611800200900001'
|| '23F80140701800005700001'
|| '33N20140227801174000001'
|| '13S20140725800000200002'
|| '33N20140711800014700001'
|| '53M80101026800105500010'
|| '33N30140527800006800001'
|| '43N20140704800595000010'
|| '33N40140224800016700001'
|| '23F10140703800007700001'
|| '33N40140714800004500001'
|| '13D30140723800064800001'
|| '33N50140319800194800001'
|| '53D80130219803498400010'
|| '33N50140706800005400001'
|| '43N00140716800135700010'
|| '33N60140613800018100001'
|| '23N80140714800158000001'
|| '33N70140605800057100001'
|| '13N10130901800329400001'
|| '33N80140112800437900001'
|| '51020081223140154700010'
|| '33N80140514800447300001'
|| '43F80140715800129500010'
|| '33S00140711800048300001'
|| '23F70140714800003700001'
|| '33S40140710800009000001'
|| '13N30140703800016400001'
|| '33S80140513800197100001'
|| '53S50090915800010400010'
|| '31020140707140107900001'
|| '43D80140710800801400010'
|| '33D00140719800005200001'
|| '23F00140718800000600001'
|| '33D30140722800016000001'
|| '13N60140129800387700001'
|| '33D60140724800000100001'
|| '53N80080908800674800010'
|| '33F40140724800006100006'
|| '43D40140723800773300010'
|| '33M50140718800001800003'
|| '23N80140625803847700001'
|| '33N00140604800101100001'
|| '13N80140702800000900001'
|| '33N10140512800346000001'
|| '53M80120308800012400010'
|| '33N20140109800798400001'
|| '43D00140719800025300010'
|| '33N20140616800001300001'
|| '23F60140704800005100001'
|| '33N30140417800278400001'
|| '13D00140710800321200001'
|| '33N40131227800105800001'
|| '53M80080814800091200010'
|| '33N40140619800000400001'
|| '44WF0140724800002500010'
|| '33N50140212801190500001'
|| '23F00140702800045600001'
|| '33N50140611800026500001'
|| '13N00140225801033100001'
|| '33N60140515800206400001'
|| '51080080627142382000010'
|| '33N70140428800233300001'
|| '43S50140711800020900010'
|| '33N80131211801740700001'
|| '23N40140721800670900001'
|| '33N80140417801447300001'
|| '13N30131221800014600001'
|| '33P60140725800014500001'
|| '53S80080902800136000010'
|| '33S30140716800001800001'
|| '43N80140719800008200010'
|| '33S70140522800026900001'
|| '23F50140714800023500001'
|| '39M90121120800002600003'
|| '13N50140429800964300001'
|| '33C00140726800000100001'
|| '53S20080902800013000010'
|| '33D30140602800250500001'
|| '43N70140723800024300013'
|| '33D60140622800031400001'
|| '23D80140630800413300001'
|| '33F00131217800001600001'
|| '13N80140306800126100001'
|| '33K80140728800000100001'
|| '53N00100422800188700010'
|| '33N00140509800163700001'
|| '43N50140723800006800010'
|| '33N10140303800469200001'
|| '23N20140716800081300001'
|| '33N20131109800100000001'
|| '19000140714800027800001'
|| '33N20140521800098800001'
|| '53M80100215800001900010'
|| '33N30140305800086900001'
|| '43N40140722800041600010'
|| '33N30140719800001900001'
|| '23F40140723800018300001'
|| '33N40140525800095100001'
|| '13F20140718800019100001'
|| '33N50140110800915100001'
|| '53D60120802800823400010'
|| '33N50140517800176100001'
|| '43N20140727800009900010'
|| '33N60140222800048100001'
|| '21010140724140027000001'
|| '33N70131218800264700001'
|| '13N20140403800508400001'
|| '33N80130729800029100001'
|| '51010081128140149700010'
|| '33N80140320800223200001'
|| '43N10140706800241700010'
|| '33N80140706800004200001'
|| '23N00140713800029400001'
|| '33S20140717800008300001'
|| '13N50131204800379800001'
|| '33S60140515800030100001'
|| '53S50080911800013800010'
|| '34BD0140728800000100001'
|| '43M20140725800004800002'
|| '31070140724140040600001'
|| '23F40140626800034700001'
|| '33D20140702800625900001'
|| '13N70140707800042400001'
|| '33D50140705800013200001'
|| '53N80080708800857200010'
|| '33D80140711800829300001'
|| '43D81140723800312900010'
|| '33I20140726800000100001'
|| '23S80140715800007400001'
|| '33N00140306800395400001'
|| '13S50140708800012900002'
|| '33N00140727800000100001'
|| '53M80111101800115700010'
|| '33N10140709800017100001'
|| '43D50140726800040100010'
|| '33N20140418800417700001'
|| '23M80140711800088400001'
|| '33N30131221800014600001'
|| '13D60140703800557400001'
|| '33N30140624800027100001'
|| '53M20140328800012300010'
|| '33N40140425800003900001'
|| '43D10140727800013400010'
|| '33N50131204800379800001'
|| '23F20140725800000100001'
|| '33N50140422800052200001'
|| '13N10140622800130000001'
|| '33N60131212800167000001'
|| '51050080724140011500010'
|| '33N60140711800043000001'
|| '41040140724140060900010'
|| '33N70140704800014000001'
|| '23S50140718800018800001'
|| '33N80140221800822300001'
|| '13N40140412800127700001'
|| '33N80140611800039700001'
|| '53S70081201800015000010'
|| '33S10140721800007400001'
|| '43S80140721800014700010'
|| '33S50140625800180400001'
|| '23M40140703800002500001'
|| '33S80140718800000700001'
|| '13N60140705800002000001'
|| '31040140727140000400001'
|| '53S00081013800001400010'
|| '33D10140715800427400001'
|| '43S00140627800000400010'
|| '33D40140720800002000001'
|| '23F20140710800005100001'
|| '33D70140728800000100001'
|| '13S10140724800000400002'
|| '33F80140714800012500001'
|| '53M80130221800044600011'
|| '33N00131128800300900001'
|| '43N80140625802348700010'
|| '33N00140702800016800001'
|| '23S30140626800004100001'
|| '33N10140614800127900001'
|| '13D20140727800000100001'
|| '33N20140303800143700001'
|| '53M80090427800026600010'
|| '33N20140714800008600001'
|| '43N60140721800089800010'
|| '33N30140530800176100001'
|| '23F80140722800008000001'
|| '33N40140302800703900001'
|| ' ende'
) ) ;
DCL KEYSRR2 CHAR(32720) INIT( ( /* ?????????? */
/* RR2 2014-09-08-10.01.46 */
'3YM90140310800010700003'
|| '33F20140103800051000001'
|| '33N00140808800000200001'
|| '33N20140114800860000001'
|| '33N30131210800445000001'
|| '33N40131229800168000001'
|| '33N40140701800222000001'
|| '33N50140429800969000001'
|| '33N60140531800108000001'
|| '33N70140705800005000001'
|| '33N80140505801518000001'
|| '31000140805140001300001'
|| '33F60140401800020000001'
|| '33N00140829800000100001'
|| '33N20140117800646000001'
|| '33N30131214800120000001'
|| '33N40131231800275000001'
|| '33N40140703800006000001'
|| '33N50140501800074000001'
|| '33N60140604800041000001'
|| '33N70140807800000100001'
|| '33N80140507800459000001'
|| '31000140808140064700001'
|| '33F80140605800076000001'
|| '33N10140117800111000001'
|| '33N20140120800119000001'
|| '33N30140101800199000001'
|| '33N40140105800407000001'
|| '33N40140705800221000001'
|| '33N50140504800657000001'
|| '33N60140606800157000001'
|| '33N80130904800094000001'
|| '33N80140511800108000001'
|| '31000140831140000200001'
|| '33I00140802800000200001'
|| '33N10140124800161000001'
|| '33N20140124800247000001'
|| '33N30140114800380000001'
|| '33N40140109800223000001'
|| '33N40140807800000400001'
|| '33N50140506800002000001'
|| '33N60140610800154000001'
|| '33N80131024802315000001'
|| '33N80140513800284000001'
|| '31010140731140029400001'
|| '33MX0140807800000100001'
|| '33N10140128800124000001'
|| '33N20140126800887000001'
|| '33N30140122800061000001'
|| '33N40140116800486000001'
|| '33N50130903800927000001'
|| '33N50140508801038000001'
|| '33N60140612800155000001'
|| '33N80131114802239000001'
|| '33N80140515801355000001'
|| '31010140807140000300001'
|| '33M10140225800002000004'
|| '33N10140209800156000001'
|| '33N20140202800509000001'
|| '33N30140126800320000001'
|| '33N40140121800095000001'
|| '33N50131112800305000001'
|| '33N50140510800209000001'
|| '33N60140614800055000001'
|| '33N80131123801248000001'
|| '33N80140519800449000001'
|| '31010140830140000100001'
|| '33M80140830800000100005'
|| '33N10140216800014000001'
|| '33N20140204800148000001'
|| '33N30140131800353000001'
|| '33N40140125800348000001'
|| '33N50131118800637000001'
|| '33N50140512800317000001'
|| '33N60140616800005000001'
|| '33N80131202801997000001'
|| '33N80140521801245000001'
|| '31010140908140000100001'
|| '33N00131016800470000001'
|| '33N10140223800023000001'
|| '33N20140208800085000001'
|| '33N30140202800548000001'
|| '33N40140128800471000001'
|| '33N50131129801047000001'
|| '33N50140515800730000001'
|| '33N60140619800096000001'
|| '33N80131208801226000001'
|| '33N80140524800802000001'
|| '31020140808140147200001'
|| '33N00131111800036000001'
|| '33N10140303800600000001'
|| '33N20140216800216000001'
|| '33N30140222800115000001'
|| '33N40140130800364000001'
|| '33N50131201800343000001'
|| '33N50140518800084000001'
|| '33N60140621800034000001'
|| '33N80131216803356000001'
|| '33N80140527800731000001'
|| '31020140831140000100001'
|| '33N00131205800657000001'
|| '33N10140307800130000001'
|| '33N20140224801063000001'
|| '33N30140303800027000001'
|| '33N40140202800494000001'
|| '33N50131203800245000001'
|| '33N50140520800555000001'
|| '33N60140623800244000001'
|| '33N80131218801577000001'
|| '33N80140529800037000001'
|| '31030140731140005700001'
|| '33N00131217800772000001'
|| '33N10140320800402000001'
|| '33N20140227800676000001'
|| '33N30140310800315000001'
|| '33N40140209800119000001'
|| '33N50131209801162000001'
|| '33N50140522801127000001'
|| '33N60140627800095000001'
|| '33N80131223800503000001'
|| '33N80140601800202000001'
|| '31030140830140000200001'
|| '33N00140114800028000001'
|| '33N10140322800103000001'
|| '33N20140305800121000001'
|| '33N30140319800173000001'
|| '33N40140218800553000001'
|| '33N50131216800172000001'
|| '33N50140525800385000001'
|| '33N60140629800002000001'
|| '33N80131226800647000001'
|| '33N80140603801074000001'
|| '31030140908140000100001'
|| '33N00140120800413000001'
|| '33N10140327800489000001'
|| '33N20140309800470000001'
|| '33N30140325800369000001'
|| '33N40140225800087000001'
|| '33N50131220801440000001'
|| '33N50140527801786000001'
|| '33N60140702800277000001'
|| '33N80140102800366000001'
|| '33N80140605800207000001'
|| '31040140807140000100001'
|| '33N00140131800376000001'
|| '33N10140330800533000001'
|| '33N20140312800756000001'
|| '33N30140327800518000001'
|| '33N40140227800744000001'
|| '33N50131222801149000001'
|| '33N50140529800077000001'
|| '33N60140704800163000001'
|| '33N80140106801826000001'
|| '33N80140607800074000001'
|| '31040140831140000100001'
|| '33N00140223800508000001'
|| '33N10140408800108000001'
|| '33N20140318800770000001'
|| '33N30140406800171000001'
|| '33N40140304800123000001'
|| '33N50131229801356000001'
|| '33N50140531800403000001'
|| '33N60140804800144100001'
|| '33N80140108801567000001'
|| '33N80140609800307000001'
|| '31050140731140612100001'
|| '33N00140228800648000001'
|| '33N10140416800283000001'
|| '33N20140323800479000001'
|| '33N30140416800042000001'
|| '33N40140308800130000001'
|| '33N50140103800996000001'
|| '33N50140602800096000001'
|| '33N60140808800000200001'
|| '33N80140113802296000001'
|| '33N80140611800028000001'
|| '31050140807140000100001'
|| '33N00140303800790000001'
|| '33N10140421800126000001'
|| '33N20140326800028000001'
|| '33N30140419800085000001'
|| '33N40140314800343000001'
|| '33N50140105800784000001'
|| '33N50140604800094000001'
|| '33N70131124800081000001'
|| '33N80140115800826000001'
|| '33N80140613800015000001'
|| '31050140831140000100001'
|| '33N00140309800206000001'
|| '33N10140430800164000001'
|| '33N20140330800610000001'
|| '33N30140425800613000001'
|| '33N40140318800099000001'
|| '33N50140107800338000001'
|| '33N50140606800010000001'
|| '33N70131210800177000001'
|| '33N80140120800915000001'
|| '33N80140615800063000001'
|| '31060140731140338300001'
|| '33N00140320800024000001'
|| '33N10140505800484000001'
|| '33N20140404800577000001'
|| '33N30140428800643000001'
|| '33N40140321800146000001'
|| '33N50140109800522000001'
|| '33N50140608800261000001'
|| '33N70131226800179000001'
|| '33N80140123802194000001'
|| '33N80140617800137000001'
|| '31060140808140031700001'
|| '33N00140324800133000001'
|| '33N10140515800245000001'
|| '33N20140413800178000001'
|| '33N30140504800101000001'
|| '33N40140323800023000001'
|| '33N50140116800233000001'
|| '33N50140610800080000001'
|| '33N70131229800383000001'
|| '33N80140126800876000001'
|| '33N80140619800011000001'
|| '31060140831140000100001'
|| '33N00140326800681000001'
|| '33N10140524800153000001'
|| '33N20140418800151000001'
|| '33N30140509800231000001'
|| '33N40140325800039000001'
|| '33N50140121801187000001'
|| '33N50140612800117000001'
|| '33N70140116800083000001'
|| '33N80140204800646000001'
|| '33N80140621800436000001'
|| '31070140731140186500001'
|| '33N00140328800531000001'
|| '33N10140527800408000001'
|| '33N20140423800105000001'
|| '33N30140514800383000001'
|| '33N40140328800711000001'
|| '33N50140126800825000001'
|| '33N50140614800313000001'
|| '33N70140206800215000001'
|| '33N80140206800610000001'
|| '33N80140623800409000001'
|| '31070140808140031200001'
|| '33N00140331800470000001'
|| '33N10140601800383000001'
|| '33N20140425800072000001'
|| '33N30140521800180000001'
|| '33N40140330800301000001'
|| '33N50140130800263000001'
|| '33N50140616800075000001'
|| '33N70140212800060000001'
|| '33N80140208800919000001'
|| '33N80140625800383000001'
|| '31070140831140000100001'
|| '33N00140402800104000001'
|| '33N10140603800290000001'
|| '33N20140429800800000001'
|| '33N30140527800100000001'
|| '33N40140401800033000001'
|| '33N50140203800468000001'
|| '33N50140618800418000001'
|| '33N70140217800081000001'
|| '33N80140213802377000001'
|| '33N80140627800016000001'
|| '31080140731140569100001'
|| '33N00140412800066000001'
|| '33N10140605800139000001'
|| '33N20140503800460000001'
|| '33N30140529800007000001'
|| '33N40140403800449000001'
|| '33N50140209800589000001'
|| '33N50140620800074000001'
|| '33N70140301800241000001'
|| '33N80140220802028000001'
|| '33N80140629800052000001'
|| '31080140830140000100001'
|| '33N00140416800147000001'
|| '33N10140608800021000001'
|| '33N20140514800091000001'
|| '33N30140531800122000001'
|| '33N40140406800059000001'
|| '33N50140211800732000001'
|| '33N50140622800018000001'
|| '33N70140312800181000001'
|| '33N80140223800028000001'
|| '33N80140701800116000001'
|| '31080140908140000200001'
|| '33N00140425800089000001'
|| '33N10140610800376000001'
|| '33N20140520800869000001'
|| '33N30140602800002000001'
|| '33N40140409800481000001'
|| '33N50140220800023000001'
|| '33N50140624800112000001'
|| '33N70140319800214000001'
|| '33N80140225800756000001'
|| '33N80140703800116000001'
|| '33B80991111800014000000'
|| '33N00140429800515000001'
|| '33N10140614800015000001'
|| '33N20140523800025000001'
|| '33N30140604800083000001'
|| '33N40140414800600000001'
|| '33N50140222800506000001'
|| '33N50140626800080000001'
|| '33N70140321800023000001'
|| '33N80140227801290000001'
|| '33N80140705800024000001'
|| '33D10140807800500100001'
|| '33N00140501800472000001'
|| '33N10140616800007000001'
|| '33N20140525800806000001'
|| '33N30140606800133000001'
|| '33N40140416800600000001'
|| '33N50140226800162000001'
|| '33N50140628800059000001'
|| '33N70140325800306000001'
|| '33N80140301800860000001'
|| '33N80140807800000100001'
|| '33D11140807800000100001'
|| '33N00140507800065000001'
|| '33N10140618800336000001'
|| '33N20140528800184000001'
|| '33N30140609800076000001'
|| '33N40140421800202000001'
|| '33N50140301800620000001'
|| '33N50140630800112000001'
|| '33N70140328800423000001'
|| '33N80140303801190000001'
|| '33N80140809800000100001'
|| '33D20140226800491900001'
|| '33N00140515800568000001'
|| '33N10140621800011000001'
|| '33N20140530800047000001'
|| '33N30140611800062000001'
|| '33N40140424800676000001'
|| '33N50140303800520000001'
|| '33N50140702800256000001'
|| '33N70140404800040000001'
|| '33N80140309800692000001'
|| '33S00140415800062000001'
|| '33D20140630801262900001'
|| '33N00140522800596000001'
|| '33N10140623800382000001'
|| '33N20140601800191000001'
|| '33N30140613800042000001'
|| '33N40140429800757000001'
|| '33N50140305800688000001'
|| '33N50140704800448000001'
|| '33N70140415800088000001'
|| '33N80140311802130000001'
|| '33S00140617800051000001'
|| '33D20140807800000200001'
|| '33N00140526800186000001'
|| '33N10140625800395000001'
|| '33N20140603800003000001'
|| '33N30140615800055000001'
|| '33N40140503800024000001'
|| '33N50140308800070000001'
|| '33N50140804800007700001'
|| '33N70140426800288000001'
|| '33N80140316800441000001'
|| '33S10140205800038000001'
|| '33D21140807804259300001'
|| '33N00140528800296000001'
|| '33N10140627800065000001'
|| '33N20140605800003000001'
|| '33N30140618800288000001'
|| '33N40140506800181000001'
|| '33N50140310800009000001'
|| '33N50140808800000100001'
|| '33N70140514800229000001'
|| '33N80140318800199000001'
|| '33S20140507800068000001'
|| '33D30140607800003900001'
|| '33N00140601800149000001'
|| '33N10140629800026000001'
|| '33N20140607800102000001'
|| '33N30140620800079000001'
|| '33N40140512800011000001'
|| '33N50140315800346000001'
|| '33N60131117800164000001'
|| '33N70140517800013000001'
|| '33N80140320801870000001'
|| '33S30140624800045000001'
|| '33D40140701800241900001'
|| '33N00140603800595000001'
|| '33N10140701800255000001'
|| '33N20140609800520000001'
|| '33N30140622800062000001'
|| '33N40140519800507000001'
|| '33N50140317800555000001'
|| '33N60131208800385000001'
|| '33N70140520800081000001'
|| '33N80140322801579000001'
|| '33S40140704800045000001'
|| '33D40140807800000100001'
|| '33N00140605800298000001'
|| '33N10140703800007000001'
|| '33N20140611800007000001'
|| '33N30140624800174000001'
|| '33N40140525800420000001'
|| '33N50140319800556000001'
|| '33N60140108800318000001'
|| '33N70140526800169000001'
|| '33N80140324802845000001'
|| '33S50140124800115000001'
|| '33D50140412800108900001'
|| '33N00140607800022000001'
|| '33N10140705800029000001'
|| '33N20140613800061000001'
|| '33N30140626800171000001'
|| '33N40140529800207000001'
|| '33N50140322800351000001'
|| '33N60140124800369000001'
|| '33N70140528800435000001'
|| '33N80140327802116000001'
|| '33S50140401800208000001'
|| '33D50140609800048900001'
|| '33N00140609800146000001'
|| '33N10140807800000100001'
|| '33N20140615800131000001'
|| '33N30140628800271000001'
|| '33N40140602800018000001'
|| '33N50140324801043000001'
|| '33N60140127800269000001'
|| '33N70140601800139000001'
|| '33N80140329801146000001'
|| '33S50140523800090000001'
|| '33D50140625801303900001'
|| '33N00140611800201000001'
|| '33N20100917800505000001'
|| '33N20140617800275000001'
|| '33N30140630800530000001'
|| '33N40140604800052000001'
|| '33N50140326800605000001'
|| '33N60140203800231000001'
|| '33N70140605800175000001'
|| '33N80140401800850000001'
|| '33S50140808800000100001'
|| '33D50140630801278000001'
|| '33N00140613800046000001'
|| '33N20130901800171000001'
|| '33N20140619800066000001'
|| '33N30140702800020000001'
|| '33N40140606800022000001'
|| '33N50140328800041000001'
|| '33N60140207800208000001'
|| '33N70140607800013000001'
|| '33N80140404800554000001'
|| '33S60140527800062000001'
|| '33D50140807800100100001'
|| '33N00140615800063000001'
|| '33N20131113800776000001'
|| '33N20140621800009000001'
|| '33N30140704800164000001'
|| '33N40140608800007000001'
|| '33N50140330800136000001'
|| '33N60140222800113000001'
|| '33N70140609800131000001'
|| '33N80140407800549000001'
|| '33S80140401800035000002'
|| '33D60140531800035900001'
|| '33N00140617800078000001'
|| '33N20131116800291000001'
|| '33N20140623800044000001'
|| '33N30140804800000100001'
|| '33N40140610800615000001'
|| '33N50140401800522000001'
|| '33N60140227800547000001'
|| '33N70140611800114000001'
|| '33N80140409800003000001'
|| '33S80140423800300000001'
|| '33D60140630800247900001'
|| '33N00140619800117000001'
|| '33N20131118800291000001'
|| '33N20140625800160000001'
|| '33N30140808800000100001'
|| '33N40140612800075000001'
|| '33N50140406800093000001'
|| '33N60140318800246000001'
|| '33N70140614800026000001'
|| '33N80140413800565000001'
|| '33S80140522800153000001'
|| '33D70140621800002700001'
|| '33N00140621800036000001'
|| '33N20131124800204000001'
|| '33N20140627800420000001'
|| '33N40131101800401000001'
|| '33N40140614800060000001'
|| '33N50140409800825000001'
|| '33N60140328800117000001'
|| '33N70140617800150000001'
|| '33N80140415802392000001'
|| '33S80140702800212000001'
|| '33D70140705800027900001'
|| '33N00140623800015000001'
|| '33N20131204801017000001'
|| '33N20140629800001000001'
|| '33N40131126800468000001'
|| '33N40140616800186000001'
|| '33N50140412800035000001'
|| '33N60140414800063000001'
|| '33N70140619800132000001'
|| '33N80140418800514000001'
|| '33VN0140830800000100001'
|| '33D80140406800127900001'
|| '33N00140625800946000001'
|| '33N20131213800597000001'
|| '33N20140701800138000001'
|| '33N40131202800971000001'
|| '33N40140619800202000001'
|| '33N50140415800029000001'
|| '33N60140419800051000001'
|| '33N70140621800106000001'
|| '33N80140421800195000001'
|| '34MX0140829800006000003'
|| '33D80140702804432900001'
|| '33N00140627800395000001'
|| '33N20131219800569000001'
|| '33N20140703800031000001'
|| '33N40131205800623000001'
|| '33N40140622800066000001'
|| '33N50140417800209000001'
|| '33N60140501800358000001'
|| '33N70140623800163000001'
|| '33N80140424801907000001'
|| '39B80120913800000500000'
|| '33D80140705800126800001'
|| '33N00140629800335000001'
|| '33N20131222800615000001'
|| '33N20140705800183000001'
|| '33N40131213800502000001'
|| '33N40140624800501000001'
|| '33N50140421800489000001'
|| '33N60140504800125000001'
|| '33N70140625800458000001'
|| '33N80140427800059000001'
|| '39MS0120327800009500005'
|| '33D80140808800845300001'
|| '33N00140701800329000001'
|| '33N20131226800183000001'
|| '33N20140807800000100001'
|| '33N40131216800563000001'
|| '33N40140626800304000001'
|| '33N50140423800633000001'
|| '33N60140516800186000001'
|| '33N70140629800296000001'
|| '33N80140429803669000001'
|| '39M90121206800003900004'
|| '33D82140807800000100001'
|| '33N00140705800234000001'
|| '33N20140105800425000001'
|| '33N30131110800087000001'
|| '33N40131220800962000001'
|| '33N40140628800103000001'
|| '33N50140425800174000001'
|| '33N60140521800300000001'
|| '33N70140702800040000001'
|| '33N80140502800717000001'
|| '3dM90140310800010700003'
|| '33F10140618800013000001'
|| '33N00140807800000100001'
|| '33N20140111800266000001'
|| '33N30131202800147000001'
|| '33N40131227800524000001'
|| '33N40140630800052000001'
|| '33N50140428801272000001'
|| '33N60140530800228000001'
|| '33N70140704800052000001'
|| '33N80140504801586000001'
|| '31000140731140399800001'
|| '33F40140331800034000001'
|| '33N00140810800000100001'
|| '33N20140116800408000001'
|| '33N30131213800108000001'
|| '33N40131230800378000001'
|| '33N40140702800186000001'
|| '33N50140430800126000001'
|| '33N60140602800084000001'
|| '33N70140804800000100001'
|| '33N80140506802599000001'
|| '31000140807140000100001'
|| '33F80140409800027000001'
|| '33N10140116800115000001'
|| '33N20140118800252000001'
|| '33N30131228800184000001'
|| '33N40140104800205000001'
|| '33N40140704800425000001'
|| '33N50140502800552000001'
|| '33N60140605800142000001'
|| '33N70140808800000100001'
|| '33N80140508800002000001'
|| '31000140830140000100001'
|| '33G00140830800000200001'
|| '33N10140120800218000001'
|| '33N20140121800540000001'
|| '33N30140105800387000001'
|| '33N40140107800129000001'
|| '33N40140804800202200001'
|| '33N50140505801843000001'
|| '33N60140609800025000001'
|| '33N80131021801796000001'
|| '33N80140512800403000001'
|| '31000140908140000100001'
|| '33I20140802800000100001'
|| '33N10140126800574000001'
|| '33N20140125800179000001'
|| '33N30140119800350000001'
|| '33N40140115800566000001'
|| '33N40140808800000100001'
|| '33N50140507800099000001'
|| '33N60140611800080000001'
|| '33N80131109800545000001'
|| '33N80140514801372000001'
|| '31010140805140001600001'
|| '33MX0140830800005100001'
|| '33N10140130800560000001'
|| '33N20140130800228000001'
|| '33N30140125800049000001'
|| '33N40140119800173000001'
|| '33N50131029800666000001'
|| '33N50140509800228000001'
|| '33N60140613800033000001'
|| '33N80131122802386000001'
|| '33N80140518800313000001'
|| '31010140808140023700001'
|| '33M80140810800000600003'
|| '33N10140210800382000001'
|| '33N20140203800043000001'
|| '33N30140130800566000001'
|| '33N40140124800241000001'
|| '33N50131116800218000001'
|| '33N50140511800035000001'
|| '33N60140615800178000001'
|| '33N80131201801345000001'
|| '33N80140520800979000001'
|| '31010140831140000100001'
|| '33N00130924800227000001'
|| '33N10140222800158000001'
|| '33N20140206800202000001'
|| '33N30140201800261000001'
|| '33N40140127800338000001'
|| '33N50131119800160000001'
|| '33N50140514800814000001'
|| '33N60140618800153000001'
|| '33N80131206802219000001'
|| '33N80140523802233000001'
|| '31020140807140000200001'
|| '33N00131104800324000001'
|| '33N10140228800115000001'
|| '33N20140209800193000001'
|| '33N30140213800239000001'
|| '33N40140129800294000001'
|| '33N50131130800823000001'
|| '33N50140517800177000001'
|| '33N60140620800071000001'
|| '33N80131212800902000001'
|| '33N80140526800129000001'
|| '31020140830140000100001'
|| '33N00131115800363000001'
|| '33N10140304800295000001'
|| '33N20140217800532000001'
|| '33N30140227800084000001'
|| '33N40140131800222000001'
|| '33N50131202800235000001'
|| '33N50140519800756000001'
|| '33N60140622800167000001'
|| '33N80131217801610000001'
|| '33N80140528800524000001'
|| '31020140908140000200001'
|| '33N00131208800269000001'
|| '33N10140309800093000001'
|| '33N20140225801573000001'
|| '33N30140304800091000001'
|| '33N40140205800539000001'
|| '33N50131204800739000001'
|| '33N50140521800088000001'
|| '33N60140626800181000001'
|| '33N80131219802125000001'
|| '33N80140530800149000001'
|| '31030140807140000100001'
|| '33N00131222800352000001'
|| '33N10140321800273000001'
|| '33N20140302800575000001'
|| '33N30140312800229000001'
|| '33N40140213800090000001'
|| '33N50131211800606000001'
|| '33N50140523800580000001'
|| '33N60140628800028000001'
|| '33N80131225801277000001'
|| '33N80140602800383000001'
|| '31030140831140000100001'
|| '33N00140119800111000001'
|| '33N10140326800657000001'
|| '33N20140307800661000001'
|| '33N30140322800039000001'
|| '33N40140222800251000001'
|| '33N50131218801522000001'
|| '33N50140526800233000001'
|| '33N60140701800141000001'
|| '33N80131227801742000001'
|| '33N80140604800454000001'
|| '31040140731140173700001'
|| '33N00140122800506000001'
|| '33N10140329800120000001'
|| '33N20140311800631000001'
|| '33N30140326800353000001'
|| '33N40140226800286000001'
|| '33N50131221800276000001'
|| '33N50140528800472000001'
|| '33N60140703800384000001'
|| '33N80140105801599000001'
|| '33N80140606800293000001'
|| '31040140830140000100001'
|| '33N00140212800294000001'
|| '33N10140402800111000001'
|| '33N20140316800251000001'
|| '33N30140328800230000001'
|| '33N40140303800719000001'
|| '33N50131224801000000001'
|| '33N50140530800068000001'
|| '33N60140705800097000001'
|| '33N80140107800715000001'
|| '33N80140608800006000001'
|| '31040140908140000300001'
|| '33N00140225801147000001'
|| '33N10140414800152000001'
|| '33N20140320800733000001'
|| '33N30140408800429000001'
|| '33N40140306800539000001'
|| '33N50140101800447000001'
|| '33N50140601800172000001'
|| '33N60140807800000100001'
|| '33N80140112801498000001'
|| '33N80140610800008000001'
|| '31050140805140004900001'
|| '33N00140301800186000001'
|| '33N10140419800034000001'
|| '33N20140325800633000001'
|| '33N30140417800227000001'
|| '33N40140312800518000001'
|| '33N50140104800128000001'
|| '33N50140603800042000001'
|| '33N70131119800282000001'
|| '33N80140114801345000001'
|| '33N80140612800079000001'
|| '31050140830140000100001'
|| '33N00140305800668000001'
|| '33N10140429800505000001'
|| '33N20140327800717000001'
|| '33N30140424800369000001'
|| '33N40140317800056000001'
|| '33N50140106800034000001'
|| '33N50140605800005000001'
|| '33N70131128800549000001'
|| '33N80140118801110000001'
|| '33N80140614800067000001'
|| '31050140908140000100001'
|| '33N00140311800370000001'
|| '33N10140501800496000001'
|| '33N20140403800509000001'
|| '33N30140427800572000001'
|| '33N40140319800022000001'
|| '33N50140108801209000001'
|| '33N50140607800007000001'
|| '33N70131216800370000001'
|| '33N80140121800699000001'
|| '33N80140616800007000001'
|| '31060140807140000100001'
|| '33N00140323800397000001'
|| '33N10140508800051000001'
|| '33N20140412800063000001'
|| '33N30140502800401000001'
|| '33N40140322800157000001'
|| '33N50140114801204000001'
|| '33N50140609800027000001'
|| '33N70131227800132000001'
|| '33N80140124800051000001'
|| '33N80140618800495000001'
|| '31060140830140000100001'
|| '33N00140325800362000001'
|| '33N10140519800025000001'
|| '33N20140417800621000001'
|| '33N30140505800173000001'
|| '33N40140324800386000001'
|| '33N50140120800760000001'
|| '33N50140611800100000001'
|| '33N70140105800128000001'
|| '33N80140128800259000001'
|| '33N80140620800007000001'
|| '31060140908140000100001'
|| '33N00140327800880000001'
|| '33N10140525800496000001'
|| '33N20140421800039000001'
|| '33N30140513800319000001'
|| '33N40140327800088000001'
|| '33N50140125800446000001'
|| '33N50140613800200000001'
|| '33N70140126800369000001'
|| '33N80140205801496000001'
|| '33N80140622800015000001'
|| '31070140807140000100001'
|| '33N00140329800360000001'
|| '33N10140530800061000001'
|| '33N20140424800709000001'
|| '33N30140520800232000001'
|| '33N40140329800062000001'
|| '33N50140128801877000001'
|| '33N50140615800055000001'
|| '33N70140211800047000001'
|| '33N80140207801795000001'
|| '33N80140624800176000001'
|| '31070140830140000100001'
|| '33N00140401800123000001'
|| '33N10140602800188000001'
|| '33N20140428801296000001'
|| '33N30140523800010000001'
|| '33N40140331800541000001'
|| '33N50140202801228000001'
|| '33N50140617800382000001'
|| '33N70140215800047000001'
|| '33N80140209801236000001'
|| '33N80140626800033000001'
|| '31070140908140000100001'
|| '33N00140404800479000001'
|| '33N10140604800033000001'
|| '33N20140502800690000001'
|| '33N30140528800066000001'
|| '33N40140402800280000001'
|| '33N50140205801414000001'
|| '33N50140619800309000001'
|| '33N70140227800246000001'
|| '33N80140218801117000001'
|| '33N80140628800837000001'
|| '31080140807140000100001'
|| '33N00140413800258000001'
|| '33N10140606800115000001'
|| '33N20140509800118000001'
|| '33N30140530800071000001'
|| '33N40140404800103000001'
|| '33N50140210800084000001'
|| '33N50140621800160000001'
|| '33N70140304800510000001'
|| '33N80140221800262000001'
|| '33N80140630800238000001'
|| '31080140831140000100001'
|| '33N00140424800507000001'
|| '33N10140609800029000001'
|| '33N20140515800803000001'
|| '33N30140601800213000001'
|| '33N40140407800139000001'
|| '33N50140219800158000001'
|| '33N50140623800230000001'
|| '33N70140313800146000001'
|| '33N80140224800568000001'
|| '33N80140702800035000001'
|| '31090140830140000100001'
|| '33N00140428800824000001'
|| '33N10140611800030000001'
|| '33N20140522800427000001'
|| '33N30140603800230000001'
|| '33N40140411800331000001'
|| '33N50140221800876000001'
|| '33N50140625800178000001'
|| '33N70140320800332000001'
|| '33N80140226800199000001'
|| '33N80140704800059000001'
|| '33D00140807800000100001'
|| '33N00140430800576000001'
|| '33N10140615800202000001'
|| '33N20140524800208000001'
|| '33N30140605800122000001'
|| '33N40140415800157000001'
|| '33N50140224800454000001'
|| '33N50140627800521000001'
|| '33N70140323800178000001'
|| '33N80140228803075000001'
|| '33N80140804800000100001'
|| '33D10140808800000100001'
|| '33N00140502800273000001'
|| '33N10140617800138000001'
|| '33N20140527800629000001'
|| '33N30140608800027000001'
|| '33N40140420800081000001'
|| '33N50140228800458000001'
|| '33N50140629800033000001'
|| '33N70140327800239000001'
|| '33N80140302802456000001'
|| '33N80140808800000100001'
|| '33D20131204800315900001'
|| '33N00140513800173000001'
|| '33N10140620800089000001'
|| '33N20140529800172000001'
|| '33N30140610800287000001'
|| '33N40140422800127000001'
|| '33N50140302800142000001'
|| '33N50140701800233000001'
|| '33N70140330800210000001'
|| '33N80140304802796000001'
|| '33N80140830800000100001'
|| '33D20140610801207900001'
|| '33N00140519800690000001'
|| '33N10140622800136000001'
|| '33N20140531800006000001'
|| '33N30140612800149000001'
|| '33N40140427800297000001'
|| '33N50140304800641000001'
|| '33N50140703800199000001'
|| '33N70140406800231000001'
|| '33N80140310801685000001'
|| '33S00140506800077000001'
|| '33D20140704800822700001'
|| '33N00140525800326000001'
|| '33N10140624800143000001'
|| '33N20140602800014000001'
|| '33N30140614800026000001'
|| '33N40140501800586000001'
|| '33N50140307800589000001'
|| '33N50140705800053000001'
|| '33N70140423800081000001'
|| '33N80140312800223000001'
|| '33S00140701800108000001'
|| '33D20140808800155900001'
|| '33N00140527800297000001'
|| '33N10140626800242000001'
|| '33N20140604800009000001'
|| '33N30140616800282000001'
|| '33N40140505800435000001'
|| '33N50140309800857000001'
|| '33N50140807800000100001'
|| '33N70140427800630000001'
|| '33N80140317801292000001'
|| '33S10140617800027000001'
|| '33D22140807800023500001'
|| '33N00140529800082000001'
|| '33N10140628800110000001'
|| '33N20140606800031000001'
|| '33N30140619800003000001'
|| '33N40140508800070000001'
|| '33N50140313801059000001'
|| '33N60131004800195000001'
|| '33N70140516800139000001'
|| '33N80140319800608000001'
|| '33S30140610800030000001'
|| '33D30140807800000100001'
|| '33N00140602800242000001'
|| '33N10140630800146000001'
|| '33N20140608800172000001'
|| '33N30140621800004000001'
|| '33N40140515800213000001'
|| '33N50140316800154000001'
|| '33N60131121800190000001'
|| '33N70140518800195000001'
|| '33N80140321800798000001'
|| '33S40140327800008000001'
|| '33D40140703801119900001'
|| '33N00140604800001000001'
|| '33N10140702800338000001'
|| '33N20140610800191000001'
|| '33N30140623800405000001'
|| '33N40140520800022000001'
|| '33N50140318800430000001'
|| '33N60131209800082000001'
|| '33N70140523800332000001'
|| '33N80140323801195000001'
|| '33S50140108800112000001'
|| '33D41140807800000100001'
|| '33N00140606800051000001'
|| '33N10140704800138000001'
|| '33N20140612800628000001'
|| '33N30140625800412000001'
|| '33N40140527800344000001'
|| '33N50140321800112000001'
|| '33N60140115800069000001'
|| '33N70140527800506000001'
|| '33N80140325800258000001'
|| '33S50140305800151000001'
|| '33D50140526801452900001'
|| '33N00140608800123000001'
|| '33N10140804800128800001'
|| '33N20140614800030000001'
|| '33N30140627800584000001'
|| '33N40140530800046000001'
|| '33N50140323800373000001'
|| '33N60140126800060000001'
|| '33N70140531800073000001'
|| '33N80140328802448000001'
|| '33S50140430800214000001'
|| '33D50140618803747300001'
|| '33N00140610800014000001'
|| '33N10140808800000400001'
|| '33N20140616800102000001'
|| '33N30140629800126000001'
|| '33N40140603800074000001'
|| '33N50140325801723000001'
|| '33N60140129800462000001'
|| '33N70140602800034000001'
|| '33N80140330800136000001'
|| '33S50140701800250000001'
|| '33D50140626800000200001'
/* ????????????????? */
|| ' ende'
) ) ;
DCL 1 keys based(addr(keysRR2))
, 5 one (1420)
, 10 kSrv char(1)
, 10 kOrd char(17)
, 10 kRun char(5 )
;
/* builtins decl */
dcl (addr, binary, fixed, length, pliRetv,trim, string) builtin;
/*_____________________________________________________________________
main */
/* inits */
put ('start of qznzgfm') skip;
put (' parm ', length($parm), ':', $parm, '|') skip;
do kMax=1 to 99000 while (kOrd(kMax) ^= '');
/* put ('kMax='|| kMax /* || ', srv=' || kSrv(ix)
|| ', ord=' || kOrd(kMax) || ' run=' || kRun(kMax)) skip;
*/ end;
do ix=1 to 6 ;
/* put ('ix='|| ix || ', pool=' || poolSrv(ix)
|| ', view=' || poolView(ix) ) skip;
*/ end;
if substr($parm, 1, 1) = 'D' then
put ('kMax='|| kMax || ' dynamic') skip;
else if substr($parm, 1, 1) = 'C' then
put ('kMax='|| kMax || ' dynamic Concentrate literals') skip;
else if substr($parm, 1, 1) = 'M' then
put ('kMax='|| kMax || ' dynamic parameter Markes') skip;
else if substr($parm, 1, 1) = 'S' then
put ('kMax='|| kMax || ' static') skip;
else if substr($parm, 1, 1) = 'N' then
put ('kMax='|| kMax || ' null') skip;
else
put ('kMax='|| kMax || ' ??????') skip;
call sql_connect();
put ('connected') skip;
sqlDAPtr = addr(spaceSQLDA);
sqlN = 20;
ix = 0;
do ix=1 to 9999999 while (cnt.cnt < 1000) ;
if ix >= kMax then
ix = 1;
cnt.cnt = cnt.cnt + 1;
iSrv = poolSrv(fixed(kSrv(ix)));
iOrd = kOrd(ix);
iRun = kRun(ix);
if substr($parm, 1, 1) = 'D' then
call viewSelect('D');
else if substr($parm, 1, 1) = 'C' then
call viewSelect('CONCENTRATE STATEMENTS WITH LITERALS');
else if substr($parm, 1, 1) = 'M' then
call viewSelect('M');
else if substr($parm, 1, 1) = 'S' then
call selStatic(iSrv);
else if substr($parm, 1, 1) = 'N' then
call selNull(iSrv);
else
call err(sourceLine(), 'bad fun ' || $parm);
call sql_commit;
end;
put ('cnt=' || cnt.cnt || ' prepare=' || cnt.prp
|| ' fetch=' || cnt.fet
|| ' fetc1=' || cnt.fet1
|| ' commit=' || cnt.com ) skip;
return;
/*_____________________________________________________________________
subroutines */
selNull: proc(vk);
dcl vk char(8);
dcl (srv#, fet#) bin fixed(31) init(0);
dcl sqlString char(1000) var init('');
do srv# = 1 to hBound(srvPool.poolSrv,1)
while( srvPool.poolSrv(srv#) ^= vk);
end;
if srv# > hBound(poolSrv,1) then
call err(sourceLine(), 'srv ' || iSrv || ' not found');
cnt.fet1 = cnt.fet1 + 1;
end selNull;
viewSelect: proc(attr); /* 3 varianten dynmische sql */
dcl attr char(*) var;
dcl (srv#, fet#) bin fixed(31) init(0);
dcl sqlString char(1000) var init('');
do srv# = 1 to hBound(srvPool.poolSrv,1)
while( srvPool.poolSrv(srv#) ^= iSrv);
end;
if srv# > hBound(poolSrv,1) then
call err(sourceLine(), 'srv ' || iSrv || ' not found');
if attr <> 'M' then do;
jOrd = '''' || iOrd || '''';
jRun = '''' || iRun || '''';
end;
else do;
jOrd = '?';
jRun = '?';
end;
sqlString = ' select messageNumber'
|| ', messageField'
||' from '||poolView(srv#)
||' where orderRefNumber = ' || jOrd
||' and runningNumber = ' || jRun
||' and messageNumber >= 3'
||' order by messageNumber'
||' with ur'
;
/*put('srv=' || iSrv || ' view=' || poolView(srv#)) skip;
put('sql=' || sqlString) skip; */
if substr(attr, 1, 1) <> 'C' then
exec sql prepare oDynDB2 into :sqlDA from :sqlString ;
else
exec sql prepare oDynDB2 into :sqlDA
attributes :attr from :sqlString ;
cnt.prp = cnt.prp + 1;
if sqlCode ^= 0 then
call sqlErr(sourceLine(), 'prepare oDynDB2');
exec sql declare onlinePool cursor for oDynDB2 ;
if attr <> 'M' then
exec sql open onlinePool;
else
exec sql open onlinePool using :iOrd, :iRun;
if sqlCode ^= 0 then
call sqlErr(sourceLine(), 'open onlinePool');
do forever;
exec sql fetch onlinePool into :oMsgNo, :oMsg ;
fet# = fet# + 1;
if sqlCode = 100 then
leave;
if sqlCode ^= 0 then
call sqlErr(sourceLine(), 'Fetch onlinePool');
/* put ('fetched no=' || oMsgNo || ' msg=' || oMsg); */
end;
cnt.fet = cnt.fet + fet#;
if fet# = 1 then
cnt.fet1 = cnt.fet1 + 1;
exec sql close onlinePool;
if sqlCode ^= 0 then
call sqlErr(sourceLine(), 'close onlinePool');
end viewSelect;
%dcl oneClCnt fixed;
% oneClCnt = 0;
%oneCl: procedure(pKey, pView) ;
dcl (pKey, pView) character;
oneClCnt = oneClCnt + 1;
answer('/* comment eins k=pKey v=pView */') skip;
answer('/* comment eins k=' || pKey || ' v=' ||pView || '*/')skip;
if oneClCnt = 1 then
answer('if vk = ''' || pKey || ''' then do;')skip;
else
answer('else if vk = ''' || pKey || ''' then do;')skip;
answer(' put(''oneCl(' || pkey || ', '
|| pView || ''') skip;') skip;
answer(' end;')skip;
%end oneCl;
%activate oneCl;
selStatic2: proc(vk);
dcl vk char(8);
oneCl(kEins, vEins)
oneCl(kZwei, vZwei)
end selStatic2;
% dcl pDo fixed;
% dcl (pSrv, pSrvQ, pView, pViewQ, pCur, pCurQ, pCom, pDoT) char;
% dcl (ppSrv, ppView) (6) character;
% ppSrv (1) = 'SIC' ;
% ppSrv (2) = 'CHECK' ;
% ppSrv (3) = 'GFM' ;
% ppSrv (4) = 'SWIFT' ;
% ppSrv (5) = 'TELEX' ;
% ppSrv (6) = 'SICI' ;
% ppView(1) = 'VNZ100A1V' ;
% ppView(2) = 'VNZ101A1V' ;
% ppView(3) = 'VNZ106A1V' ;
% ppView(4) = 'VNZ111A1V' ;
% ppView(5) = 'VNZ113A1V' ;
% ppView(6) = 'VNZ118A1V' ;
;
selStatic: proc(vk);
dcl vk char(8);
dcl fet# bin(31) init(0);
%do pDo = 1 to 6;
%pDoT = trim(pDo);
%pSrv = ppSrv(pDo);
%pSrvQ = quote(pSrv);
%pView = ppView(pDo);
%pViewQ = quote(pView);
%pCur = 'c' || pSrv;
%pCurQ= quote(pCur);
%pCom = '/* pDo=' || pDoT || ' srv=' || pSrv
|| ' view=' || pView || ' */';
%if pDo = 1 then %do;
if vK = pSrvQ then do; pCom
%end;
%else %do;
else if vK = pSrvQ then do; pCom
%end;
/* put('selStatic ' || pDo || ' ' || pSrvQ
|| ' -> ' || pViewQ) skip; */
exec sql declare pCur cursor for
select messageNumber, messageField
from pView
where orderRefNumber = :io.iOrd
and runningNumber = :iRun
and messageNumber >= 3
order by messageNumber
with ur
;
exec sql open pCur;
if sqlCode ^= 0 then
call sqlErr(sourceLine(), 'open ' || pCurQ);
do forever;
exec sql fetch pCur into :oMsgNo, :oMsg ;
fet# = fet# + 1;
if sqlCode = 100 then
leave;
if sqlCode ^= 0 then
call sqlErr(sourceLine(), 'Fetch ' || pCurQ);
/*put ('fetched no=' || oMsgNo || ' msg=' || oMsg) skip;*/
end;
exec sql close pCur;
if sqlCode ^= 0 then
call sqlErr(sourceLine(), 'close ' || pCurQ);
cnt.fet = cnt.fet + fet#;
if fet# = 1 then
cnt.fet1 = cnt.fet1 + 1;
end; pCom
%end;
else do;
call err(sourceLine(), 'bad server ' || vK);
end;
end selStatic;
/*
sql connect__________________________________________________________*/
%include yxrrsaf;
dcl ssid char(04) init('DBOF');
dcl plan char(08) init('QZTEST');
sql_connect:proc();
if yxrrsaf('CONNECT',ssid,plan) ^= 0 then
put('qznzgfm'
,'Error in YXRRSAF Connect Call'
,'SSID - '||ssid
,'PLAN - '||plan) skip;
end sql_connect;
sql_disconnect:proc();
if yxrrsaf('DISCONNECT') ^= 0 then
put('qznzgfm'
,'Error in YXRRSAF Disconnect Call') skip;
end sql_disconnect;
/*
commit_______________________________________________________________*/
sql_commit: proc();
if yxrrsaf('COMMIT') ^= 0 then
put('qznzgfm'
,'Error in YXRRSAF Commit Call');
cnt.com = cnt.com + 1;
end sql_commit;
sql_rollback: proc();
if yxrrsaf('ROLLBACK') ^= 0 then
put('qznzgfm'
,'Error in YXRRSAF ROLLBACK Call');
end sql_rollback;
DCL DSNTIAR ENTRY EXTERNAL OPTIONS(ASM INTER RETCODE);
sqlMsg: proc ();
DCL MSGWIDTH FIXED BIN(31) INIT(72);
DCL MSGBLEN FIXED BIN(15) INIT(20); /* MAX # SQL MESSAGES */
DCL i FIXED BIN(31) INIT(0);
DCL 01 MESSAGE /* MESSAGE RETURN BUFFER */
, 02 MESSAGEL FIXED BIN(15) INIT(1440) /* BUFFER LENGTH */
, 02 MESSAGET(MSGBLEN) CHAR(msgWidth) INIT((*)' ') /* TEXT */
;
/* NOW PRINT OUT SQL STATEMENT RESULTS VIA DSNTIAR */
CALL DSNTIAR(SQLCA,MESSAGE,MSGWIDTH);
IF PLIRETV ^= 0 THEN DO; /* IF THE RETURN CODE ISN'T ZERO@08*/
/* ISSUE AN ERROR MESSAGE @08*/
PUT EDIT (' RETURN CODE ', PLIRETV, /* @08*/
' FROM MESSAGE ROUTINE DSNTIAR.') /* @08*/
(COL(1), A(13), F(8), A(30)); /* ISSUE THE MESSAGE @08*/
END; /* END ISSUE AN ERROR MESSAGE @08*/
DO I = 1 TO MSGBLEN /* @08*/
WHILE (MESSAGET(I) ^= ''); /* @08*/
PUT EDIT ( MESSAGET(I) ) (COL(1), A(msgWIdth)); /* @08*/
END; /* @08*/
end SqlMsg;
sqlErr: proc (lNo, txt);
DCL lNo FIXED BIN(31);
dcl txt char(500) varying;
put ('sqlErr at ' || trim(edit(lNo, 'ZZZZZZZZZ9'))
|| ': ' || txt) skip;
call sqlMsg;
call sql_rollback;
put ('error signal error') skip;
signal error;
end sqlErr;
err: proc (lNo, txt);
DCL lNo FIXED BIN(31);
dcl txt char(500) varying;
put ('err at ' || trim(edit(lNo, 'ZZZZZZZZZ9'))
|| ': ' || txt) skip;
call sql_rollback;
put ('error signal error') skip;
signal error;
end err;
end qznzgfm;
}¢--- A540769.WK.PLB(QZPLB) cre=2014-06-04 mod=2014-06-04-13.51.26 A540769 -----
*process default(connected);
QZPLB: proc($parm) options(main);
/*_____________________________________________________________________
declarationS */
%include pgmanfa; /* On Error */
dcl $parm char(80) varying;
/* printer file */
dcl sysprint file print;
/* sqlca struc */
exec sql include sqlca;
/* db cursor (dynamic sql) sql */
exec sql declare c1 cursor for s1;
/* counters decl */
dcl 1 cnt
, 5 cnt bin fixed(31) init(0)
, 5 sel bin fixed(31) init(0)
, 5 ins bin fixed(31) init(0)
, 5 write_ddout bin fixed(31) init(0)
, 5 errors bin fixed(31) init(0)
, 5 commit_counter bin fixed(31) init(0)
, 5 tst char(26) init('')
, 5 fun char(126) varying init('')
;
/* builtins decl */
dcl (addr, binary, length, pliRetv,trim, string) builtin;
/*_____________________________________________________________________
main */
/* inits */
put ('start of qzPlb') skip;
put (' parm ', length($parm), ':', $parm, '|') skip;
call testBit(' 12abc');
return;
call sql_connect();
put ('connected') skip;
if substr($parm, 1, 1) = 'A' then
call doA(substr($parm, 2, 1));
else if substr($parm, 1, 1) = 'B' then
call doB;
else do;
put (' no test ') skip;
cnt.tst = '';
cnt.sel = 123;
cnt.tst = 'sel = ' || edit(sel, '9999') || ' und schluss';
put (' sel=123: ', cnt.tst) skip;
exec sql
select current timestamp into :cnt.tst
from sysibm.sysDummy1
;
put ('sql code: ', sqlCode) skip;
if sqlCode <> 0 THEN
call sqlMsg;
put ('selected current timestamp: ', cnt.tst) skip;
end;
RETURN;
/*_____________________________________________________________________
subroutines */
doA:proc($f);
dcl $f char(1);
dcl (ix, jx) bin fixed(31) init(0);
dcl (pa, fo)char(3);
dcl uu char(36);
dcl tx char(10000) varying;
do jx=1 to 5;
do ix=1 to 10000;
pa = edit(1 + mod(ix, 5), '999');
uu = 'uuid' || edit(ix, '9999') || '=uuid';
fo = 'for';
tx = copy('p=' || pa || ' uuid=' || uu || ' fo=' || fo
|| '... ', 40);
if $f = '1' then
call doV1(pa, uu, fo, tx);
else if $f = '2' then
call doV2(pa, uu, fo, tx);
else if $f = '3' then
call doV3(pa, uu, fo, tx);
end;
end;
call sql_commit;
put ('commit after ' || trim(edit(cnt.cnt, 'zzzzzz9'))
|| ' ' || $f || ': ' || cnt.fun) skip;
end doA;
doV1: proc(pa, uu, fo, tx);
dcl (pa, fo)char(3);
dcl uu char(36);
dcl tx char(10000) varying;
DCL seq BIN(31) INIT(-1);
/* put ('V1 ' || pa || ' u=' || uu || ' fo=' || fo) skip */
exec sql
select value(max(XC502_DOC_CONTENT_SEQ)+1, 1)
into :seq
from qtxCry.tQBXC5a1 where XC502_PART_NUMBER = :pa
and XC502_doc_uuid = :uu and XC502_doc_format = :fo
;
if sqlCode <> 0 then
call sqlErr(sourceLine(), 'select value ...');
/* put ('seq ' || trim(edit(seq, 'zzzzz9'))
|| ' ' || substr(tx, 1, 60)) skip */
exec sql
insert into qtxCry.tQBXC5a1
values(:pa, :uu, :fo, :seq, :tx)
;
if sqlCode <> 0 then
call sqlErr(sourceLine(), 'insert values ...');
cnt.cnt = cnt.cnt + 1;
cnt.fun = 'select & insert';
end doV1;
doV2: proc(pa, uu, fo, tx);
dcl (pa, fo)char(3);
dcl uu char(36);
dcl tx char(10000) varying;
/* put ('V2 ' || pa || ' u=' || uu || ' fo=' || fo) skip */
exec sql
insert into qtxCry.tQBXC5a1
select :pa, :uu, :fo
, value(max(XC502_DOC_CONTENT_SEQ)+1, 1)
, :tx
from qtxCry.tQBXC5a1 where XC502_PART_NUMBER = :pa
and XC502_doc_uuid = :uu and XC502_doc_format = :fo
;
if sqlCode <> 0 then
call sqlErr(sourceLine(), 'insert ... select');
cnt.cnt = cnt.cnt + 1;
cnt.fun = 'insert from select';
end doV2;
doV3: proc(pa, uu, fo, tx);
dcl (pa, fo)char(3);
dcl uu char(36);
dcl tx char(10000) varying;
DCL seq BIN(31) INIT(-1);
/* put ('V3 ' || pa || ' u=' || uu || ' fo=' || fo) skip */
exec sql
select XC502_DOC_CONTENT_SEQ into :seq
from final table
(
insert into qtxCry.tQBXC5a1
select :pa, :uu, :fo
, value(max(XC502_DOC_CONTENT_SEQ)+1, 1)
, :tx
from qtxCry.tQBXC5a1 where XC502_PART_NUMBER = :pa
and XC502_doc_uuid = :uu and XC502_doc_format = :fo
) ;
/* put ('got seq', seq) skip */
if sqlCode <> 0 then
call sqlErr(sourceLine(), 'select ... insert ... select');
cnt.cnt = cnt.cnt + 1;
cnt.fun = 'select from insert from select';
end doV3;
doB:proc();
end doB;
/*
sql connect__________________________________________________________*/
%include yxrrsaf;
sql_connect:proc();
dcl ssid char(04) init('DP4G');
dcl plan char(08) init('QZTEST');
if yxrrsaf('CONNECT',ssid,plan) ^= 0 then
put('QZPLB'
,'Error in YXRRSAF Call'
,'SSID - '||ssid
,'PLAN - '||plan);
end sql_connect;
/*
commit_______________________________________________________________*/
sql_commit: proc();
if yxrrsaf('COMMIT') ^= 0 then
put('QZPLB'
,'Error in YXRRSAF Commit Call');
end sql_commit;
sql_rollback: proc();
if yxrrsaf('ROLLBACK') ^= 0 then
put('QZPLB'
,'Error in YXRRSAF ROLLBACK Call');
end sql_rollback;
DCL DSNTIAR ENTRY EXTERNAL OPTIONS(ASM INTER RETCODE);
sqlMsg: proc ();
DCL MSGWIDTH FIXED BIN(31) INIT(72);
DCL MSGBLEN FIXED BIN(15) INIT(20); /* MAX # SQL MESSAGES */
DCL i FIXED BIN(31) INIT(0);
DCL 01 MESSAGE /* MESSAGE RETURN BUFFER */
, 02 MESSAGEL FIXED BIN(15) INIT(1440) /* BUFFER LENGTH */
, 02 MESSAGET(MSGBLEN) CHAR(msgWidth) INIT((*)' ') /* TEXT */
;
/* NOW PRINT OUT SQL STATEMENT RESULTS VIA DSNTIAR */
CALL DSNTIAR(SQLCA,MESSAGE,MSGWIDTH);
IF PLIRETV ^= 0 THEN DO; /* IF THE RETURN CODE ISN'T ZERO@08*/
/* ISSUE AN ERROR MESSAGE @08*/
PUT EDIT (' RETURN CODE ', PLIRETV, /* @08*/
' FROM MESSAGE ROUTINE DSNTIAR.') /* @08*/
(COL(1), A(13), F(8), A(30)); /* ISSUE THE MESSAGE @08*/
END; /* END ISSUE AN ERROR MESSAGE @08*/
DO I = 1 TO MSGBLEN /* @08*/
WHILE (MESSAGET(I) ^= ''); /* @08*/
PUT EDIT ( MESSAGET(I) ) (COL(1), A(msgWIdth)); /* @08*/
END; /* @08*/
end SqlMsg;
sqlErr: proc (lNo, txt);
DCL lNo FIXED BIN(31);
dcl txt char(500) varying;
put ('error at ' || trim(edit(lNo, 'ZZZZZZZZZ9'))
|| ': ' || txt) skip;
call sqlMsg;
call sql_rollback;
put ('error signal error') skip;
signal error;
end sqlErr;
testBit: proc(i);
dcl i char(6);
dcl p pointer;
dcl b1 bit(1) dimension (48) based (p);
dcl b8 fixed binary (8) unsigned dim ( 6) based (p);
dcl b6 bit (6) unaligned dim ( 8) based (p);
dcl b bit(6) dimension ( 8) based (p);
DCL x FIXED BIN(31) INIT(0);
put ('testBit i = ' || i) skip;
p = addr(i);
do x=1 to 48;
put ('b1 ', x , ' => ' , b1(x)) skip;
end;
do x=1 to 6;
put ('b8 ', x , ' => ' , b8(x)) skip;
end;
do x=1 to 8;
put edit('b6', x , ' => ', b6(x), ' bin ', binary(b6(x)))
(a(4), f(5) , a(4), b(6), a(4), f(5)) skip;
end;
end testBit;
end QZPLB;