zOs/PLB/QZCDPUT3
*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;