zOs/PLB/QZCDPUT
*process RULES(LAXSEMI); /* suppress semicolon-warning */
*process RULES(BYNAME) ; /* allow "by name" */
*process RULES(NOLAXIF); /* suppress conversion in boolean expression */
/**** ***************************************************************/
/* QZCDPUT = test version fuer performance test von YCDPUT3 */
/* */
/* Letzte Source-Änderung: 02. Oct. 2013 14:00 A959103 */
/* */
/********************************************************************/
/* */
/* Autor : Markus Niederhauser */
/* Datum : 18.01.2001 */
/* */
/*********************************************************************/
QZCDPUT: proc($parm) options(main);
%include pgmanfa;
dcl $parm char(80) varying;
dcl fun char(1);
dcl pliRetv builtin ;
/*********************************************************************/
/* Change-Log MDL095 2008-02-14 */
/*********************************************************************/
/* */
/*-------------------------------------------------------------------*/
/* Release Req./Ticket PID Text */
/*-------------------------------------------------------------------*/
/* Z1311080 PR014104JI-29 A959103 add CD57 getCifsLong_4.0 */
/* Z1308090 PRQ1348 A959103 add CA59 & CA60 */
/* PRQ1348 A727897 add RM38 */
/*-------------------------------------------------------------------*/
/* Z1305100 PRQ1262 A393014 add RM36 + RM37 */
/*-------------------------------------------------------------------*/
/* Z1302080 PRQ1123 A393014 Maintaining clientIds */
/* */
/* PRQ1123 mn@20121115 Markus Niederhauser */
/* add CD56 */
/* CD56: IF getCifsLong_3.0 */
/* PRQ1123 ad@20121220 Andreas Dahinden */
/* CA14, CI74: YYAUPRE changed to YCDAURA */
/*-------------------------------------------------------------------*/
/* Z1211090 PRQ1026 A393014 Maintaining clientIds */
/* */
/* PRQ1026 mn@20120913 Markus Niederhauser */
/* if clientId='' then ignore comparison */
/* PRQ1026 mn@20120718 Markus Niederhauser */
/* CA37, CA38, CA39 & CA40 add - YCDGETB */
/* - YCDOEFU */
/*-------------------------------------------------------------------*/
/* Z1208100 PRQ882 A393014 CA37, CA38 & CA39 add YCDGETB */
/* */
/* PRQ882 mn@20120608 Markus Niederhauser */
/* CA37, CA38 & CA39 add YCDGETB */
/*-------------------------------------------------------------------*/
/* Z1205110 PRQ757 A393014 CI70 maxAllowedInputSeq= 600! */
/* Z1205110 PRQ771 A959103 CD55 IF getCifsLong_2.0 */
/* Z1205110 PRQ770 A959103 CA14 IF searchCif_2.0 */
/* */
/* PRQ628 mn@20111024 Markus Niederhauser */
/* CI70: maxAllowedInputSeq= 600! */
/* PRQ771 ad@20120229 Andreas Dahinden */
/* CD55: IF getCifsLong_2.0 */
/* PRQ770 ad@20120229 Andreas Dahinden */
/* CA14: IF searchCif_2.0 */
/*-------------------------------------------------------------------*/
/* Z1202100 PRQ628 A393014 crm4rmicMaxNodes */
/* */
/* PRQ628 mn@20111024 Markus Niederhauser */
/* crm4rmicMaxNodes -> RM68 + RM50 */
/*-------------------------------------------------------------------*/
/* Z1109090 PRQ381 A393014 CA90+CA93:Maske */
/* */
/* PRQ381 mn@20110719 Markus Niederhauser */
/* CA90+CA93:Maske forApplUse_01 */
/*-------------------------------------------------------------------*/
/*--------------+--------+-------------------------------------------*/
/* CcYy-mm-dd ! OFR ! Name, Instradation */
/* NME@CcYyMmDd ! xxx.0 ! - Correction A */
/* NM@CcYyMmDd ! yyy.0 ! - Correction B */
/*--------------+--------+-------------------------------------------*/
/* 2010-08-13 ! ! Niederhauser Markus, KCAB 323 */
/* mn@20100510 ! 479.x ! - add the fields */
/* ! ! - currentDate */
/* ! ! - dayOfWeek */
/*--------------+--------+-------------------------------------------*/
/* 2010-05-14 ! ! Niederhauser Markus, KCAB 323 */
/* mn@20100310 ! 479.x ! - CI70 */
/* mn@20100302 ! 479.x ! - CD71 */
/* mn@20100107 ! 479.x ! - CI76 */
/* mn@20100107 ! 479.x ! - CD87 */
/*--------------+--------+-------------------------------------------*/
/* 2010-02-12 ! ! Niederhauser Markus, KCAB 323 */
/* mn@20100105 ! 479.x ! - CI88 */
/* mn@20091218 ! 479.x ! - RM98: Mail=Y */
/* mn@20091216 ! 479.x ! - RM84 */
/* mn@20091208 ! 479.x ! - CI90 + CI91 */
/* mn@20091111 ! 479.x ! - YDA0720 */
/* ! 479.x ! - CA51 + CA52 + CA53 + CA54 */
/*--------------+--------+-------------------------------------------*/
/* 2009-11-13 ! ! Niederhauser Markus, KCAB 323 */
/* mn@20090824 ! 479.x ! - YCD083A, C & D */
/*--------------+--------+-------------------------------------------*/
/* 2009-08-14 ! ! Niederhauser Markus, KCAB 323 */
/* mn@20090603 ! 479.x ! - YCD083B */
/*--------------+--------+-------------------------------------------*/
/* 2009-02-13 ! ! Shanthi Chinnadurai, KCAB 323 */
/* cs@20081106 ! 312.5 ! - RM0980R trace option */
/* mn@20081110 ! 312.5 ! - YCD080B */
/*--------------+--------+-------------------------------------------*/
/* 2008-05-09 ! ! Markus Niederhauser, KSFI 411 */
/* mn@20080310 ! 191.6 ! - Eliminate EPLI-Warnings */
/*--------------+--------+-------------------------------------------*/
/* 2007-11-09 ! ! Markus Niederhauser, KSFI 411 */
/* mn@20070705 ! 988.0 ! - explementation of @compvers */
/* gl20070813 ! 988.0 ! - Compvers included */
/* mn@20070913 ! 988.0 ! - explementation of ceetdli */
/*--------------+----------------------------------------------------*/
/* 2007-08-10 ! Markus Niederhauser, KSFA 521 */
/* mn@20070424 ! - TCD900A1 -> TCD153A1 */
/*--------------+----------------------------------------------------*/
/* 2007-05-11 ! Markus Niederhauser, KSFA 521 */
/* mn@20070323 ! - YRM065B-Process */
/*--------------+----------------------------------------------------*/
/* 2007-03-09 ! Markus Niederhauser, KSFA 521 */
/* mn@20061031 ! - TCD150 -> TCD900 */
/*--------------+----------------------------------------------------*/
/* 2006-03-10 ! Markus Niederhauser, KBIE 21 */
/* mn@20051221 ! - Init anpassen für _C__77_ */
/*--------------+----------------------------------------------------*/
/* */
/* 11.11.2005 Markus Niederhauser / KBIE 21 /* Start mn20050830 */
/* - CDADMIN erweitern mit Release-Nummer */
/* */
/* 12.08.2005 Markus Niederhauser / KBIE 21 /* Start tm 050406 */
/* - Region-Name in TCD150 einfügen */
/* */
/* 17.09.2004 Markus Niederhauser KASK 21 /* Start mn 040826 */
/* - Plausis überarbeiten */
/* - PID='NOSECUR ' zulassen */
/* */
/* 04.02.2002 Markus Niederhauser KASK 21 /* mn 040202 */
/* Erweiterung mit Array von PIDs */
/* */
/* */
/*********************************************************************/
/*********************************************************************/
/** **/
/*********************************************************************/
/** **/
/** A. Zusammenhang **/
/** =============== **/
/** Es gibt die Tabelle TCD150. Auf dieser Tabelle kann von Hand **/
/** spezifiziert werden, ob eine gewisse Transaktion in die **/
/** Region putten soll oder nicht. **/
/** **/
/** **/
/** **/
/** B. Zweck **/
/** ======== **/
/** - Das aufrufende Programm übergibt dem yCDPUT3 den Programm- **/
/** Namen (CD150001) und die Version (CD150003). **/
/** - yCDPUT3 sucht die vorhandene Row, die den Schlüssel-feldern **/
/** CD150001 bis CD150004 entspricht. **/
/** - Gibt es keine passende Row, wird eine Row in die Tabelle **/
/** TCD150 eingefügt mit traceLevel=0 und keine PIDs. **/
/** - Die gefundene/eingefügte Row wird an das aufrufende **/
/** Programm zurückgegeben. Und zwar den Trace-Level (CD150011), **/
/** alle PIDs (CD150012) plus die Bit-Batterie von Put-Flags **/
/** **/
/** **/
/** **/
/** **/
/** C. Inhaltsverzeichnis **/
/** ===================== **/
/** **/
/** 1.0 D e k l a r a t i o n e n **/
/** 1.1 Kommunikationsstruktur **/
/** 1.2 Files **/
/** 1.3 Datuemer **/
/** 1.4 DB2 Applikatorisch **/
/** 1.5 DB2 Infra **/
/** 1.6 Strukturen **/
/** 1.7 Uebrige Deklarationen **/
/** **/
/** 2.0 O n - U n i t s **/
/** **/
/** 3.0 I n i t i a l i s i e r u n g e n **/
/** 3.1 Datuemer **/
/** 3.2 Outputparameter **/
/** **/
/** 4.0 M a i n - L o g i c **/
/** **/
/** 5.0 P r o z e d u r e n **/
/** 5.1 plausi_input_fields_ok **/
/** 5.3 PutProc **/
/** **/
/** **/
/*********************************************************************/
1/**-----------------------------------------------------------------**/
/** **/
/** 1.0 D e k l a r a t i o n e n **/
/** **/
/**-----------------------------------------------------------------**/
DCL TCD152KEYS CHAR(13000) INIT( (
'CA0420 CA0420 '||
'CA0440 CA0440 '||
'CA0510 CA0510 '||
'CA0530 CA0530 '||
'CB1300 CIFRelations_1_0 '||
'CB1300 CIFRelations_1_1 '||
'CB1300 CIFRelations_1_2 '||
'CB1310 CIFRelations_1_0 '||
'CB1310 CIFRelations_1_1 '||
'CD0790 CD0790 '||
'CI0020 CI0020 '||
'CI0050 IMS-online '||
'CI0060 IMS-online '||
'CI0210 CI0210 '||
'CI0220 CI0220 '||
'CI0230 CI0230 '||
'CI0310 CI0310 '||
'CI0320 CI0320 '||
'CI0880 CI0880 '||
'CUS_0004 CIFS_CustomerClone_1_0 '||
'CUS_0004 CIFS_CustomerClone_1_1 '||
'CUS_0008 CIFS_ServicingHistory_1_0 '||
'CUS_0010 CIFS_Customer_1_0 '||
'CUS_0010 CIFS_Customer_1_1 '||
'CUS_0013 CIFS_Customer_1_1 '||
'CUS_0014 CIFS_GetDetailForCifs_1_0 '||
'CUS_0015 CIFS_GetDetailForCifs_1_0 '||
'CUS_0024 CIFS_EntireClient_1_0 '||
'CUS_0025 PARS_SearchPartner_1_0 '||
'CUS_0030 CIFS_CCSegmentation_1_0 '||
'CUS_0031 CIFS_CCSegmentation_Update_1_0 '||
'CUS_0032 CIFS_CCSegmentation_Update_1_0 '||
'CUS_0035 CIFS_CifHistory_1_0 '||
'CUS_0036 CIFS_CifSearch_1_0 '||
'CUS_0036 CIFS_CifSearch_1_1 '||
'CUS_0037 CIFS_CifSearch_1_0 '||
'CUS_0037 CIFS_CifSearch_1_1 '||
'CUS_0038 CIFS_CifSearch_1_0 '||
'CUS_0038 CIFS_CifSearch_1_1 '||
'CUS_0039 CIFS_CifSearch_1_1 '||
'CUS_1082 CIFS_CifCreate_3_0 '||
'CUS_1116 CIFS_CifsByFHolders_3_0 '||
'CUS_1235 CIFRelations_1_1 '||
'CUS_1235 CIFRelations_1_2 '||
'CUS_1245 CIFRelations_1_1 '||
'CUS_1245 CIFRelations_1_2 '||
'CUS_1415 CIFS_CifUpdate_2_0 '||
'CUS_1416 CIFS_CifUpdate_2_0 '||
'CUS_1417 CIFS_CifUpdate_2_0 '||
'CUS_1418 CIFS_CifUpdate_2_0 '||
'CUS_1444 CIFS_Servicing_Update_3_0 '||
'CUS_1445 CIFS_Servicing_Update_3_0 '||
'CUS_1446 CIFS_Servicing_Update_3_0 '||
'CUS_1447 CIFS_Servicing_Update_3_0 '||
'CUS_1527 PARS_Partner_update_7_0 '||
'CUS_1528 PARS_Partner_7_0 '||
'CUS_1529 PARS_Partner_update_7_0 '||
'CUS_1530 PARS_Partner_update_7_0 '||
'CUS_1574 PARS_Relship_6_0 '||
'CUS_1579 PARS_Relship_6_0 '||
'CUS_1584 PARS_Relship_6_0 '||
'CUS_1720 CIFS_LTInstructUpdate_1_0 '||
'CUS_1721 CIFS_LTInstructUpdate_1_0 '||
'CUS_1722 CIFS_LTInstructUpdate_1_0 '||
'CUS_1723 CIFS_LTInstructUpdate_1_0 '||
'CU5900 CU5900 '||
'CU5930 CU5930 '||
'IF001125 CUPA_BK_SearchCifsByFHolders_3_0 '||
'IF001137 PINS_AG_DeleteKuhat_2_0 '||
'IF001138 CUPA_BN_CreateKuhat_2_0 '||
'IF001139 CUPA_BN_GetKuhat_2_0 '||
'IF001490 CIFS_CifParticipant_Update_1_0 '||
'IF001490 CUS/PIIN/CUS_CifParticipant '||
'IF001490 PIIN_BG_deleteCifPart_3_0 '||
'IF001491 CIFS_CifParticipant_Update_1_0 '||
'IF001491 CUS/PIIN/CUS_CifParticipant '||
'IF001491 PIIN_BG_createCifPart_3_0 '||
'IF001492 CIFS_CifParticipant_Update_1_0 '||
'IF001492 CUS/PIIN/CUS_CifParticipant '||
'IF001492 PIIN_BG_UpdateCifPart_3_0 '||
'IF001493 CIFS_CifParticipant_Update_1_0 '||
'IF001493 CUS/PIIN/CUS_CifParticipant '||
'IF001493 PIIN_BG_GetCifPartByCifPartIdTec_3_0 '||
'IF001494 CIFS_CifParticipant_Update_1_0 '||
'IF001494 CUPA_BJ_GetCifPartAddress_1_0 0 '||
'IF001494 CUS/PIIN/CUS_CifParticipant '||
'IF001494 PIIN_BG_GetCifPartsByCifNo_3_0 '||
'IF001494 PIIN_BG_GetCifPartsByCifNo_4_0 '||
'IF001618 getPartnersWithGranitExt_1.0 '||
'IF001636 CIFS_DepositsForCifs_1_0 '||
'IF001748 CIFS_Associations_Update_1_0 '||
'IF001748 CUPA_AC_GetUpCifBusAssoc_2_0 '||
'IF001749 CIFS_Associations_Update_1_0 '||
'IF001750 CIFS_Associations_Update_1_0 '||
'IF001751 CIFS_Associations_Update_1_0 '||
'IF001753 CIFS_Associations_Update_1_0 '||
'IF001756 CIFS_Associations_Update_1_0 '||
'IF001757 CIFS_Associations_Update_1_0 '||
'IF001758 CIFS_Associations_Update_1_0 '||
'IF001764 CUPA_BL_GetCifCareFuncAssignments_2_0 '||
'IF001814 CIFS_ElectronicAddr_Update_1_1 '||
'IF001814 CUPA_BN_GetElectronicAddress_2_0 '||
'IF001815 CIFS_ElectronicAddr_Update_1_1 '||
'IF001815 CUPA_BN_DeleteElectronicAddress_2_0 '||
'IF001816 CIFS_ElectronicAddr_Update_1_0 '||
'IF001816 CIFS_ElectronicAddr_Update_1_1 '||
'IF001817 CIFS_ElectronicAddr_Update_1_0 '||
'IF001817 CIFS_ElectronicAddr_Update_1_1 '||
'IF001817 CUPA_BN_CreateElectronicAddress_2_0 '||
'IF001818 CIFS_ElectronicAddr_Update_1_0 '||
'IF001818 CIFS_ElectronicAddr_Update_1_1 '||
'IF001818 CUPA_BN_UpdateElectronicAddress_2_0 '||
'IF001923 CIFS_CifCif_Update_1_0 '||
'IF001925 CIFS_CifCif_Update_1_0 '||
'IF001926 CIFS_CifCif_Update_1_0 '||
'IF001926 PARL_AA_GetUpCifCifsForCifs_2 '||
'IF001929 CUPA_BK_SearchCif_2_0 '||
'IF002105 PIIN_BB_UpdateAmlHeader_2_0 '||
'IF002106 PIIN_BB_GetAmlHeaders_2_0 '||
'IF002106 PIIN_BB_GetAmlHeaders_3_0 '||
'IF002141 CUPA_BI_GetCifsLong_3_0 '||
'IF002141 CUPA_BI_GetCifsLong_4_0 '||
'IF002552 CIFS_GetCifNoWithAnyNo_1_0 '||
'IF002634 CIFS_GwVIndividualLimits_2_0 '||
'IF002635 CIFS_GwVIndividualLimits_2_0 '||
'IF002636 CIFS_GwVIndividualLimits_2_0 '||
'IF002637 CIFS_GwVIndividualLimits_2_0 '||
'IF003412 INST_AddrInstructionUpdate_1_0 '||
'IF003412 PINS_AD_GetAddrInstructions_2 '||
'IF003413 INST_AddrInstructionUpdate_1_0 '||
'IF123491 CUPA_BD_GetAgreementsOfCifs_2_0 '||
'IF123491 CUS/CUPA/CUS_Agreement '||
'IF123493 CUPA_BE_getProprietorsWithTaxProps_5_0 '||
'IF123493 CUPA_BE_getProprietorsWithTaxProps_6_0 '||
'IF123493 CUPA_BE_getProprietorsWithTaxProps_7_0 '||
'IF123493 CUPA_BE_GetProprietorsWithTaxProps_1_0 '||
'IF123493 CUPA_BE_GetProprietorsWithTaxProps_2_0 '||
'IF123493 CUPA_BE_GetProprietorsWithTaxProps_3_0 '||
'IF123493 CUPA_BE_GetProprietorsWithTaxProps_4_0 '||
'IF123499 CUS/CUPA/CUS_Address_Registered '||
'IF123500 CUS/CUPA/CUS_Address_Registered '||
'IF123501 CUS/CUPA/CUS_Address_Registered '||
'IF123502 CUS/CUPA/CUS_Address_Registered '||
'IF123555 PARL_AO_GetRelations_1_0 '||
'IF123578 PARL_AN_DeletePartner_1_0 '||
'IF123579 PARL_AN_CreatePartner_1_0 '||
'IF123594 PARL_AN_UpdatePartner_1_0 '||
'IF123595 PARL_AN_GetPartner_1_0 '||
'IF123615 CUPA_BE_UpdateTaxPropsOfProprietors_4_0 '||
'IF123615 CUPA_BE_UpdTaxPropsOfProprietors_1_0 '||
'IF123615 CUPA_BE_UpdTaxPropsOfProprietors_2_0 '||
'IF123615 CUPA_BN_UpdateTaxPropsOfProprietors_5_0 '||
'IF123615 CUPA_BN_UpdateTaxPropsOfProprietors_6_0 '||
'IF123615 CUPA_BN_UpdateTaxPropsOfProprietors_7_0 '||
'IF123739 CUPA_BG_creCifInvSuitabilityResult_1_0 '||
'IF123740 CUPA_BG_GetCifInvSuitabilityResult_1_0 '||
'IF123741 CUPA_BG_UpdCifInvSuitabilityResult_1_0 '||
'IF123761 PARL_AP_CreatePartnerAgreementRel_1_0 '||
'IF123763 PARL_AP_DeletePartnerAgreementRel_1_0 '||
'IF123767 PARL_AP_GetPartnerAgreementRel_1_0 '||
'IF123858 CUPA_BH_CreateCifBUChangeRequest_1_0 '||
'IF123860 CUPA_BH_DeleteCifBUChangeRequest_1_0 '||
'IF123862 CUPA_BH_GetCifBUChangeRequest_1_0 '||
'IF124117 CUPA_BI_GetCifsBaseData_1_0 '||
'IF124212 CUPA_BJ_CreateCifPartAddress_1_0 '||
'IF124214 CUPA_BJ_UpdateCifPartAddress_1_0 '||
'IF124235 CUPA_BJ_DeleteCifPartAddress_1_0 '||
'IF124274 PIIN_BG_CreateCifPartIdentifying_1_0 '||
'IF124275 CUPA_BJ_GetCifPartIdentifying_1_0 '||
'IF124276 CUPA_BJ_GetCifPartIdentifying_1_0 '||
'IF124393 CUPA_BE_GetTaxRelevanceProfile_1_0 '||
'IF124393 CUPA_BE_GetTaxRelevanceProfile_2_0 '||
'IF124406 CUPA_BE_UpdateProprietorsAssetRatios_1_0 '||
'IF124410 CUPA_BE_CreateTaxPropsOfProprietors_3_0 '||
'IF124410 CUPA_BE_CreateTaxPropsOfProprietors_4_0 '||
'IF124410 CUPA_BE_CreateTaxPropsOfProprietors_5_0 '||
'IF124410 CUPA_BE_CreTaxPropsOfProprietors_1_0 '||
'IF124410 CUPA_BE_CreTaxPropsOfProprietors_2_0 '||
'IF124556 CUPA_BM_GetAddresses_1_0 '||
'IF124557 CUPA_BM_CreateAddress_1_0 '||
'IF124558 PB_CUPA_BM_UpdateAddress_1_0 '||
'IF124559 PB_CUPA_BM_DeleteAddress_1_0 '||
'IF124852 PARL_AO_GetClientNetwork_1_0 '||
'IF124852 PARL_AO_GetClientNetwork_2_0 '||
'IF124853 PARL_AN_GetPartnerWithCifs_1_0 '||
'IF124853 PARL_AN_GetPartnerWithCifs_2_0 '||
'IF124855 PARL_AN_SearchPartnersByFHolder_1.0 '||
'IF125010 PIIN_BE_CreateCifExternalIdentifier_1_0 '||
'IF125024 PIIN_BE_GetCifExternalIdentifierC_1.0 '||
'IF125025 PIIN_BE_DeleteCifExternalIdentifier_1_0 '||
'IF125032 PIIN_BE_GetCifExternalIdentifier_1.0 '||
'IF125041 PIIN_BE_updateCifExternalIdentifier_1_0 '||
'SEC_1600 DEPS_Deposit_1_0 '||
'SEC_1601 DEPS_Deposit_1_0 '||
'SEC_1602 DEPS_Deposit_1_0 '||
'XR5080 XR5080 '||
'IF123595 PARL_AN_GetPartner_2_0 '||
'IF002552 CUPA_AR_GetCifNosWithAnyNo_2_0 '
));
DCL 1 tcd152KeyInfos,
3 tcd152KeysPtr pointer init((addr(tcd152Keys))) ,
3 tcd152KeysMax bin fixed(31) init(198) ,
3 tcd152KeysRep bin fixed(31) init(100000) ,
3 tcd152KeysStep bin fixed(31) init(37) ,
3 tcd152KeysJx bin fixed(31) init(1) ,
3 c152Found bin fixed(31) init(0) ,
3 c152SelInto bin fixed(31) init(0) ,
3 cPidClientNoFo bin fixed(31) init(0) ,
3 cPidClientFound bin fixed(31) init(0) ,
3 cPidClientErr bin fixed(31) init(0) ,
3 cPidClientOp bin fixed(31) init(0) ,
3 cPidClientF1 bin fixed(31) init(0) ,
3 cPidClientF2 bin fixed(31) init(0) ,
3 cPidClientCl bin fixed(31) init(0) ,
3 cPidClientInto bin fixed(31) init(0) ,
3 cCommit bin fixed(31) init(0) ,
3 noSql bit (1)aligned init('0'b),
3 noCommit bit (1)aligned init('1'b);
dcl tcd152KeysIx bin fixed(31) init(-1) ;
DCL 1 TCD152KEYSTR based(tcd152KeysPtr),
3 tcd152key (200) ,
5 SERVICEID char(21),
5 INTERFACENAME char(42);
dcl 1 ttGpcif ,
3 i ,
5 userPid char( 8) ,
5 clientId char(10) ,
5 padd_01 char( 2) ,
3 o ,
5 hasFound bit(1)aligned ,
5 padd_01 char( 3) ,
5 traceLevel bin fixed(31) ,
5 getRegionName char( 1) ,
5 padd_02 char( 3) ,
3 endOfStruc char( 0) ;
-/**-----------------------------------------------------------------**/
/** 1.01 Kommunikationsstruktur **/
/**-----------------------------------------------------------------**/
dcl $PyCDPUT3 ptr;
dcl 1 yCDPUT3SP char(1000) init('');
dcl PyCDPUT3 ptr init(addr(yCDPUT3SP));
dcl 1 yCDPUT3k based(pycdput3),
%include yCDPUT3K ;;
-/**-----------------------------------------------------------------**/
/** 1.02 Files **/
/**-----------------------------------------------------------------**/
dcl Sysprint file print output ;
-/**-----------------------------------------------------------------**/
/** 1.03 Datuemer **/
/**-----------------------------------------------------------------**/
%include YcdTS;
dcl TimeStamp char(26) init ('');
-/**-----------------------------------------------------------------**/
/** 1.03 IMS **/
/**-----------------------------------------------------------------**/
/*
dcl 1 tp based ( CDPUT3_ptrLtm ) ,
%include TPPCBW ; ;
*/
dcl c2 bin fixed(31) static init(2);
dcl c3 bin fixed(31) static init(3);
dcl isrt char(04) static init('ISRT');
dcl chng char(04) static init('CHNG');
dcl purg char(04) static init('PURG');
dcl ii bin fixed(31);
dcl len bin fixed(31); /* Länge */
/*
dcl totl bin fixed(31); /* Total Länge / Rest Länge*/
/*
dcl anzm bin fixed(31); /* Anzahl Messages */
dcl dtoutl bin fixed(31); /* Daten-Output-Länge */
dcl poutmsg ptr; /* Ptr für Outmsg */
dcl ltm ptr;
dcl pgm ptr;
%include nsotppcb;
dcl 1 outmsg ,
%include nsoppm;
2 isPutOn bit (1)aligned init('0'b), /* mn@20100204 */
2 processType char(1) ,
2 padd_01 char(2) ,
2 dtout char(5900) ; /* Daten-Output thb241003*/
poutmsg = addr(outmsg);
-/**-----------------------------------------------------------------**/
/** 1.2 Program-specific MDL049 2008-03-19 **/
/**-----------------------------------------------------------------**/
%DCL COMPILETIME BUILTIN;
%DCL COMP_TIME CHAR;
%COMP_TIME = '''compilation-time: ' || COMPILETIME || '''';
%DCL COMP_VERS CHAR;
%comp_VERS = '''EPLI-compiler : EPLI' || '''' ;
-/**-----------------------------------------------------------------**/
/** 1.05 DB2 TCD150 **/
/**-----------------------------------------------------------------**/
/* Table */
exec SQL
declare TCD150A1 table
%include TCD150D;;
dcl 1 TCD150,
%include TCD150;;
/* Cursor */
exec SQL
declare C_yCDPUT3 cursor for
select %include TCD150F;
from TCD150A1
where CD150001 = :CDPUT3_metaId
and CD150002 = 'YCD'
and CD150003 = 'PUT'
and CD150005 < :TimeStamp
and CD150006 >= :TimeStamp
order by CD150003 ;
/* Cursor */
exec SQL
declare C_region cursor for
select %include TCD150F;
from TCD150A1
where CD150001 = :CDPUT3_metaId
and CD150002 = 'REG'
and CD150003 = 'ION'
and CD150005 < :TimeStamp
and CD150006 >= :TimeStamp
order by CD150003 ;
/* Cursor */
exec SQL
declare C_tracePidClientId cursor for
select %include TCD150F;
from TCD150A1
where CD150001 = 'TRACE'
and
( ( CD150002 = 'CLIE'
and CD150003 = 'NTID'
)
or
(
CD150002 = 'PID '
and CD150003 = ' '
)
)
and CD150005 < :TimeStamp
and CD150006 >= :TimeStamp
;
-/**-----------------------------------------------------------------**/
/** 1.05 DB2 TCD152 **/
/**-----------------------------------------------------------------**/
/* Table */
exec SQL
declare TCD152A1 table
%include TCD152D;;
dcl 1 TCD152 ,
%include TCD152; ,
2 currentTs char(26) ,
2 dayOfWeek bin fixed(31) ;
/* Cursor */
exec SQL
declare C_tcd152 cursor for
select %include TCD152F;
, current timestamp
, dayOfWeek( current date )
from TCD152A1
where serviceId = :CDPUT3_serviceId
and interfaceName = :CDPUT3_interfaceName
;
-/**-----------------------------------------------------------------**/
/** 1.06 DB2 tcd153 **/
/**-----------------------------------------------------------------**/
/* Table */
exec SQL
declare tcd153A1 table
%include tcd153D;;
dcl tcd153_area char(1000) init('') ;
dcl 1 tcd153 based
( addr(tcd153_area) ) ,
%include tcd153; ;
-/**-----------------------------------------------------------------**/
/** 1.06 DB2 tcd900 **/
/**-----------------------------------------------------------------**/
/* Table */
exec SQL
declare tcd900A1 table
%include tcd900D;;
dcl tcd900_area char(1000) init('') ;
dcl 1 tcd900 based
( addr(tcd900_area) ) ,
%include tcd900; ;
1/**-----------------------------------------------------------------**/
/** 1.5 ceetdli **/
/**-----------------------------------------------------------------**/
/*
%include ceeibmaw ;
*/
/*
dcl ceetdli entry; mn@20070913
*/
1/**-----------------------------------------------------------------**/
/** 1.5 CDADMIN **/
/**-----------------------------------------------------------------**/
dcl 1 cdadmin based( CDPUT3_ptrCdadmin ) ,
%include cdadmins; ;
1/**-----------------------------------------------------------------**/
/** 1.5 DB2 Infrastruktur **/
/**-----------------------------------------------------------------**/
exec sql include SQLCA ;
-/**-----------------------------------------------------------------**/
/** 1.6 Strukturen **/
/**-----------------------------------------------------------------**/
dcl
1 aux , /* auxiliary */
3 isPutOn bit(1) aligned init('0'b) ,
3 putFlag(100) char(1) init((100)('')),
3 C_tcd152_open bit(1) aligned init('0'b) ,
3 C_yCDPUT3_open bit(1) aligned init('0'b) ,
3 c_region_open bit(1) aligned init('0'b) ,
3 c_tracePidClientId_open bit(1) aligned init('0'b) ,
3 ts char(26) init( '' ),
3 t bin fixed(31,0) init( 0 ) , /* tabulator */
3 p_9 pic'9' init( 0 ) ;
-/**-----------------------------------------------------------------**/
/** 1.7 Uebrige Deklarationen **/
/**-----------------------------------------------------------------**/
dcl ( addr
, cstg
, datetime
, hbound
, high
, length
, max
, min
, mod
, null
, ptradd
, string
, substr
, sysnull
, translate
, verify ) builtin;
1/**-----------------------------------------------------------------**/
/** **/
/** 2.0 O n - U n i t s **/
/** **/
/**-----------------------------------------------------------------**/
1/**-----------------------------------------------------------------**/
/** **/
/** 3.0 I n i t i a l i s i e r u n g e n **/
/** **/
/**-----------------------------------------------------------------**/
-/**-----------------------------------------------------------------**/
/** 3.1 Datuemer **/
/**-----------------------------------------------------------------**/
TimeStamp = YcdTS('E');
1/**-----------------------------------------------------------------**/
/** **/
/** 5.0 P r o z e d u r e n **/
/** **/
/**-----------------------------------------------------------------**/
/**-----------------------------------------------------------------**/
/** 5.1 plausi_input_fields_ok **/
/**-----------------------------------------------------------------**/
plausi_input_fields_ok:
Proc
returns ( bit(1) aligned );
dcl @hasFehler bit(1) aligned init('0'b);
YCDM616
do; /* Diese Prüfung muss vor dem ersten Put passieren */ YCDM616
DCL CDPUT3_whichSysprint based(addr(CDPUT3_sysprint)) char(4) ; YCDM61
if (CDPUT3_whichSysprint = '') then YCDPUT
do;
aux.isPutOn = '1'b;
CDPUT3_sysprint = sysprint;
call putM('*' ,70);
call putR('** CDPUT3_sysprint nicht abgefüllt' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
end; /* Diese Prüfung muss vor dem ersten Put passieren */ YCDM616
if ( $PyCDPUT3 = null()) then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** $pyCDPUT3 ist null' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
if aux.isPutOn then
do;
call putFrame('start'
,'plausi_input_fields_ok' ,70);
call putR('** eye . . . . . : ' ||
CDPUT3_eye ,70);
call putR('** release . . . : ' ||
CDPUT3_release ,70);
call putR('** processType . : ' ||
in.CDPUT3_processType ,70);
call putR('** interfaceName : ' ||
in.CDPUT3_interfaceName ,70);
call putR('** operationName : ' ||
in.CDPUT3_operationName ,70);
call putR('** serviceId . . : ' ||
in.CDPUT3_serviceId ,70);
call putR('** pgmName . . . : ' ||
in.CDPUT3_pgmName ,70);
call putR('** metaId . . . : ' ||
in.CDPUT3_metaId ,70);
call putR('** bereich . . . : ' ||
in.CDPUT3_bereich ,70);
call putR('** pid . . . . . : ' ||
in.CDPUT3_pid ,70);
call putR('** mainPgmName . : ' ||
in.CDPUT3_mainPgmName ,70);
call putR('** traceLevel . : ' ||
bin31_to_char(in.CDPUT3_traceLevel) ,70);
/*
call putR('** comp . . . . : ' ||
in.CDPUT3_comp ,70);
*/
end;
if (CDPUT3_eye ^= '#@YCDPUT3@#') then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDPUT3_eye ist nicht korrekt' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putR('** Eye : ' || CDPUT3_eye ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
if ( CDPUT3_release = 'Rel.0004' ) then
do;
end;
else
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDPUT3_release ist falsch' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putR('** Release : ' || CDPUT3_release ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
/*
if (in.CDPUT3_processType = '1') then /* Top-Module */
/*
do;
*/
if (in.CDPUT3_ptrCdadmin = null()) then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDPUT3_ptrCdadmin ist null' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
else
do;
if (cdadmin_01 ^= '#@CDADMIN@#') then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDADMIN_01 ist nicht korrekt' ,70);
call putR('** CDADMIN_01 : ' || CDADMIN_01 ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
if (cdadmin_01a ^= 'Rel.0001') then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDADMIN_01a ist falsch' ,70);
call putR('** CDADMIN_01a : ' || cdadmin_01a ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
end;
/*
end;
*/
if (CDPUT3_SQLCA = null()) then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDPUT3_sqlca ist null' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
if (in.CDPUT3_processType = '1') then /* Top-Module */
do;
if (CDPUT3_metaId = '') then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDPUT3_metaId ist blank' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
end;
if (in.CDPUT3_processType = '1') then /* Top-Module */
do;
if (in.CDPUT3_pid = '' |
in.CDPUT3_pid = 'specify') then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDPUT3_pid muss abgefüllt werden' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
end;
if (CDPUT3_mainPgmName = '' |
CDPUT3_mainPgmName = 'specify') then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** CDPUT3_mainPgmName muss abgefüllt werden' ,70);
call putR('** Service : ' || CDPUT3_metaId ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
if (in.CDPUT3_processType = '1') then /* Top-Module */
do;
if ( in.CDPUT3_pid ^= 'nosecur '
& in.CDPUT3_pid ^= 'NOSECUR '
& in.CDPUT3_pid ^= 'specify '
& in.CDPUT3_pid ^= '' ) then
do;
if ((verify(substr(in.CDPUT3_pid ,1,1),
'ABCDEFGHIJKLMNOPQRSTUVWXYZ') ^= 0 |
verify(substr(in.CDPUT3_pid,2,7),'0123456789 ') ^= 0)) then
do;
aux.isPutOn = '1'b;
call putM('*' ,70);
call putR('** Service . : '|| CDPUT3_metaId ,70);
call putR('** CDPUT3_pid : '||in.CDPUT3_pid ,70);
call putR('** CDPUT3_pid ist ungueltig' ,70);
call putM('*' ,70);
@hasFehler = '1'b ;
end;
end;
end;
if aux.isPutOn then
do;
call putFrame('end ','plausi_input_fields_ok' ,70);
end;
/* Analse */
/* ------ */
if @hasFehler then
do;
CDPUT3_RC = 10;
return('0'b) ;
end;
else
do;
CDPUT3_RC = 0 ;
return('1'b) ;
end;
end plausi_input_fields_ok;
1/**-----------------------------------------------------------------**/
/** 5.22 Bin31_To_Char **/
/**-----------------------------------------------------------------**/
Bin31_To_Char: proc ( @bin31 )
returns ( char(5)var );
dcl @bin31 bin fixed(31) ;
dcl @charVar char(5) var init('') ;
select ;
when ( @bin31 < 10
& @bin31 > -10 )
do;
@charVar = bin31_to_char1( @bin31 );
end;
when ( @bin31 < 100
& @bin31 > -100 )
do;
@charVar = bin31_to_char2( @bin31 );
end;
when ( @bin31 < 1000
& @bin31 > -1000 )
do;
@charVar = bin31_to_char3( @bin31 );
end;
when ( @bin31 < 10000
& @bin31 > -10000 )
do;
@charVar = bin31_to_char4( @bin31 );
end;
otherwise
do;
@charVar = bin31_to_char5( @bin31 );
end;
end; /* select ( @bin31 ) */
if @bin31 < 0 then
do;
@charVar = '-' || @charVar ;
end;
return ( @charVar ) ;
end Bin31_To_Char ;
/*
Bin31_To_Char1 mdl MDL076
Bin31_To_Char2 mdl MDL004
Bin31_To_Char3 mdl MDL003
Bin31_To_Char4 mdl MDL005
Bin31_To_Char5 mdl MDL074
*/
1/**-----------------------------------------------------------------**/
/** 5.22 Bin31_To_Char1 **/
/**-----------------------------------------------------------------**/
Bin31_To_Char1: proc ( @bin31 )
returns ( char(1) );
dcl @bin31 bin fixed(31) ;
dcl @p9 pic'9' init( 0) ;
dcl @char1 based(addr(@p9)) char ( 1 );
@p9 = @bin31 ;
return ( @char1 ) ;
end Bin31_To_Char1 ;
1/**-----------------------------------------------------------------**/
/** 5.22 Bin31_To_Char2 **/
/**-----------------------------------------------------------------**/
Bin31_To_Char2: proc ( @bin31 )
returns ( char(2) );
dcl @bin31 bin fixed(31) ;
dcl @pz9 pic'z9' init( 0) ;
dcl @char2 based(addr(@pz9)) char ( 2 );
@pZ9 = @bin31 ;
return ( @char2 ) ;
end Bin31_To_Char2 ;
1/**-----------------------------------------------------------------**/
/** 5.21 Bin31_To_Char3 **/
/**-----------------------------------------------------------------**/
Bin31_To_Char3: proc ( @bin31 )
returns ( char(3) );
dcl @bin31 bin fixed(31) ;
dcl @pzz9 pic'zz9' init( 0) ;
dcl @char3 based(addr(@pzz9)) char ( 3 );
@pZZ9 = @bin31 ;
return ( @char3 ) ;
end Bin31_To_Char3 ;
1/**-----------------------------------------------------------------**/
/** 5.23 Bin31_To_Char4 **/
/**-----------------------------------------------------------------**/
Bin31_To_Char4: proc ( @bin31 )
returns ( char(4) );
dcl @bin31 bin fixed(31) ;
dcl @pzzz9 pic'---9' init( 0) ;
dcl @char4 based(addr(@pzzz9)) char ( 4 );
@pZZZ9 = @bin31 ;
return ( @char4 ) ;
end; /* Bin31_To_Char4 */
1/**-----------------------------------------------------------------**/
/** 5.23 Bin31_To_Char5 **/
/**-----------------------------------------------------------------**/
Bin31_To_Char5: proc ( @bin31 )
returns ( char(5) );
dcl @bin31 bin fixed(31) ;
dcl @pzzzz9 pic'zzzz9' init( 0) ;
dcl @char5 based(addr(@pzzzz9)) char ( 5 );
@pZZZZ9 = @bin31 ;
return ( @char5 ) ;
end Bin31_To_Char5 ;
1/**-----------------------------------------------------------------**/
/** 5.2 Fetch_C_tcd152_ok **/
/**-----------------------------------------------------------------**/
Fetch_C_tcd152_ok:
Proc ( $p_fcyo )
returns ( bit(1) aligned );
dcl $p_fcyo ptr ;
dcl 1 @fcyo based ($p_fcyo) ,
3 i ,
5 dummy char( 0) init('') ,
3 o ,
5 hasFound bit ( 1) aligned init('') ,
5 padd_01 char( 3) init('') ,
5 end char( 0) init('') ;
dcl @isOk bit(1)aligned init('1'b);
if aux.isPutOn then
do;
call putFrame('start','Fetch_C_tcd152_ok' ,70);
end;
/*
dcl 1 @tcd152 ,
%include tcd152 ;;
*/
/*****************/
/** Fetch Row **/
/*****************/
do;
if noSql then
sqlCode = 0;
else
exec SQL
fetch C_tcd152
into :TCD152 ;
select ( sqlca.sqlcode ) ;
when ( 0 )
do;
@fcyo.o.hasFound = '1'b;
end;
when ( 100 )
do;
@fcyo.o.hasFound = '0'b;
end;
otherwise
do;
aux.isPutOn = '1'b ;
@isOk = '0'b ;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'Fetch C_tcd152'
, '1010' /* traceId */
) then @isOk = '0'b ;
end;
end;
end;
if aux.isPutOn then
do;
call putR ('** @hasFound : ' ||
@fcyo.o.hasFound ,70);
call putR ('** @isOk . . : ' ||
@isOk ,70);
call putFrame('end ','Fetch_C_tcd152_ok' ,70);
end;
return( @isOk ) ;
end Fetch_C_tcd152_ok;
1/**-----------------------------------------------------------------**/
/** 5.2 Fetch_C_tracePidClientId_ok **/
/**-----------------------------------------------------------------**/
Fetch_C_tracePidClientId_ok:
Proc ( $p_ftpc )
returns ( bit(1) aligned );
dcl $p_ftpc ptr ;
dcl 1 @ftpc based ($p_ftpc) ,
3 i ,
5 userPid char( 8) ,
5 clientId char(10) ,
5 padd_01 char( 2) ,
3 o ,
5 hasFound bit ( 1) aligned ,
5 padd_01 char( 3) ,
5 uSwitch bin fixed(31) ,
/* 1 : userPid found */
/* 2 : clientId found */
5 userPid char( 8) ,
5 clientId char(10) ,
5 padd_02 char( 2) ,
3 endOfStruc char( 0) ;
dcl @isOk bit(1)aligned init('1'b);
if aux.isPutOn then
do;
call putFrame('start','Fetch_C_tracePidClientId_ok' ,70);
end;
@ftpc.o.hasFound = '0'b;
/*****************/
/** Fetch Row **/
/*****************/
exec SQL
fetch C_tracePidClientId
into :TCD150 ;
cPidClientF1 = cPidClientF1 + 1;
do while ( sqlca.sqlcode = 0
& ^@ftpc.o.hasFound
) ;
select ( sqlca.sqlcode ) ;
when ( 0 )
do;
select;
when ( @ftpc.i.userPid = substr(tcd150.cd150011,1,8) )
do;
@ftpc.o.hasFound = '1'b ;
@ftpc.o.uSwitch = 1 ;
@ftpc.o.userPid = substr(tcd150.cd150011,1,8) ;
aux.isPutOn = '1'b ;
call putR('** getRegionName is switched on by' ||
' userPid' ,70);
call putR('** on TCD150.' ,70);
end;
when ( @ftpc.i.clientId = substr(tcd150.cd150011,1,10) )
do;
@ftpc.o.hasFound = '1'b ;
@ftpc.o.uSwitch = 2 ;
@ftpc.o.clientId = substr(tcd150.cd150011,1,10) ;
aux.isPutOn = '1'b ;
call putR('** getRegionName is switched on by' ||
' clientId' ,70);
call putR('** on TCD150.' ,70);
end;
otherwise
do;
end;
end; /* select */
end;
when ( 100 )
do;
@ftpc.o.hasFound = '0'b;
end;
otherwise
do;
aux.isPutOn = '1'b ;
@isOk = '0'b ;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'Fetch C_tracePidClientId'
, '1010' /* traceId */
) then @isOk = '0'b ;
end;
end;
exec SQL
fetch C_tracePidClientId
into :TCD150 ;
cPidClientF2 = cPidClientF2 + 1;
end; /* do while (sqlca.sqlcode = 0) */
if aux.isPutOn then
do;
call putR ('** hasFound : ' ||
@ftpc.o.hasFound ,70);
call putR ('** uSwitch . : ' ||
bin31_to_char(@ftpc.o.uSwitch) ,70);
call putR ('** userPid . : ' ||
@ftpc.o.userPid ,70);
call putR ('** clientId : ' ||
@ftpc.o.clientId ,70);
call putR ('** @isOk . . : ' ||
@isOk ,70);
call putFrame('end ','Fetch_C_tracePidClientId_ok' ,70);
end;
return( @isOk ) ;
end Fetch_C_tracePidClientId_ok;
1/**-----------------------------------------------------------------**/
/** 5.2 Fetch_C_REGION_ok **/
/**-----------------------------------------------------------------**/
Fetch_C_REGION_ok:
Proc ( $p_fcro )
returns ( bit(1) aligned );
dcl $p_fcro ptr ;
dcl 1 @fcro based ($p_fcro) ,
3 i ,
5 dummy char( 0) ,
3 o ,
5 found bit ( 1) aligned ,
5 notFound bit ( 1) aligned ,
5 padd_01 char( 2) ,
5 end char( 0) ;
if aux.isPutOn then
do;
call putFrame('start'
,'Fetch_C_REGION_ok' ,70);
end;
/*****************/
/** Fetch Row **/
/*****************/
do;
exec SQL
fetch C_REGION
into %include TCD150V;;
select ( sqlca.sqlcode ) ;
when ( 0 )
do;
@fcro.o.found = '1'b;
end;
when ( 100 )
do;
@fcro.o.notFound = '1'b;
end;
otherwise
do;
aux.isPutOn = '1'b;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'Fetch C_REGION'
, '1010' /* traceId */
) then return('0'b);
end;
end;
end;
if aux.isPutOn then
do;
call putFrame('end '
,'Fetch_C_REGION_ok' ,70);
end;
return('1'b) ;
end Fetch_C_REGION_ok;
1/**-----------------------------------------------------------------**/
/** 5.26 putM **/
/**-----------------------------------------------------------------**/
putM: proc($str , $pos);
dcl $str char(*);
dcl $pos bin fixed(31);
dcl @pos bin fixed(31) init( 0) ;
dcl @i bin fixed(31) init( 0) ;
dcl @line char(200) var init('') ;
dcl 1 @l , /* length */
3 asa bin fixed(31) init( 1) ,
3 pgmName bin fixed(31) init( 8) ,
3 corr bin fixed(31) init( 1) , /* Korrektur */
3 str bin fixed(31) init( 0) ;
dcl 1 @p , /* position */
3 t1 bin fixed(31) init( 66) , /* Tabulator 1 */
3 t2 bin fixed(31) init( 96) , /* Tabulator 2 */
3 t3 bin fixed(31) init(115) ; /* Tabulator 3 */
/* PutProc mit Wiederholbarem Input */
if ( aux.isPutOn ) then
do;
@pos = $pos ;
do; /* Repeated Character */
do @i = @l.asa+@l.pgmName+1+@l.pgmName+1+@l.corr to @pos ;
@line = @line || $str ;
end; /* next */
@line = @line || ' ' ;
end; /* Repeated Character */
do; /* Füllen bis Tab1 */
do @i = @pos+@l.corr to @p.t1 ;
@line = @line || ' ' ;
end; /* next */
end; /* Füllen bis Datum */
@pos = max(@pos , @p.t1) ;
do; /* Zeit & Datum */
if ( @pos-@l.corr < @p.t2 ) then
do;
@line = @line || translate('ij:kl:mn:opq abcd-ef-gh'
, datetime()
,'abcdefghijklmnopq'
);
end;
end; /* Zeit & Datum */
put file(CDPUT3_Sysprint) edit( CDPUT3_mainPgmName || ' ' ||
'YCDPUT3 ' ||
@line )(skip,a);
end;
end; /* putM */
1/**-----------------------------------------------------------------**/
/** 5.26 putR **/
/**-----------------------------------------------------------------**/
putR: proc($str , $pos);
dcl $str char(*);
dcl $pos bin fixed(31);
dcl @pos bin fixed(31) init( 0) ;
dcl 1 @l , /* length */
3 asa bin fixed(31) init( 1) ,
3 pgmName bin fixed(31) init( 8) ,
3 corr bin fixed(31) init( 1) , /* Korrektur */
3 str bin fixed(31) init( 0) ;
dcl 1 @p , /* position */
3 t1 bin fixed(31) init( 66) , /* Tabulator 1 */
3 t2 bin fixed(31) init( 96) , /* Tabulator 2 */
3 t3 bin fixed(31) init(115) ; /* Tabulator 3 */
dcl @i bin fixed(31) init( 0) ;
dcl @line char(200) var init( '') ;
/* PutProc mit Rahmen */
/* Dieses Procedure schreibt nur, wenn der Puts-Flag */
/* auf "on" gesetzt ist. */
if ( aux.isPutOn ) then
do;
@pos = $pos ;
do; /* Vorbereitung */
@l.str = length($str) ;
do @i = @l.str to 1 by -1
while (substr($str, @i, 1) = '') ;
end;
@l.str = @i ;
end; /* Vorbereitung */
do; /* @str */
@line = substr( $str, 1, @l.str ) ;
end; /* @str */
@pos = max(@pos , @l.str+@l.asa+2*@l.pgmName+2+4) ;
do; /* Rahmen-Abschluss */
do @i = @l.asa+@l.pgmName+1
+@l.pgmName+1+@l.str to @pos-@l.corr-4 ;
@line = @line || ' ' ;
end; /* next */
if ( @pos-@l.corr < @p.t3 ) then
@line = @line || ' ** ' ;
end; /* Rahmen-Abschluss */
do; /* Füllen bis Tab1 */
do @i = @pos+@l.corr to @p.t1 ;
@line = @line || ' ' ;
end; /* next */
end; /* Füllen bis Tab1 */
do; /* Zeit & Datum */
if ( @pos-@l.corr < @p.t2 ) then
do;
@line = @line || translate('ij:kl:mn:opq abcd-ef-gh'
, datetime()
,'abcdefghijklmnopq'
);
end;
end; /* Zeit & Datum */
put file(CDPUT3_Sysprint) edit( CDPUT3_mainPgmName || ' ' ||
'YCDPUT3 ' ||
@line )(skip,a);
end;
end; /* putR */
/**-----------------------------------------------------------------**/
/** 5.1 getDataFromTCD152_ok **/
/**-----------------------------------------------------------------**/
getDataFromTCD152_ok:
Proc(p)
returns ( bit(1) aligned );
dcl p pointer;
/**--------**/
/** open **/
/**--------**/
if ^open_C_tcd152_ok () then
do;
put ('open_C_tcd152_ok not ok') skip;
end;
else
do;
/**---------**/
/** fetch **/
/**---------**/
dcl 1 @fcyo ,
3 i ,
5 dummy char( 0) init( '' ) ,
3 o ,
5 hasFound bit ( 1) aligned init('0'b) ,
5 padd_01 char( 3) init( '' ) ,
5 end char( 0) init( '' ) ;
if ^Fetch_C_tcd152_ok ( addr(@fcyo) ) then
do;
put ('Fetch_C_tcd152_ok not ok') skip;
end;
else
do;
if ( @fcyo.o.hasFound ) then
do;
c152Found = c152Found + 1;
/* put ('Fetch_C_tcd152_ok has found') skip; */
end;
else
do;
put ('Fetch_C_tcd152_ok has notfound') skip;
end;
end; /* fetch */
end; /* open */
/**---------**/
/** close **/
/**---------**/
if ^close_C_tcd152_ok () then
do;
put ('close_C_tcd152_ok not ok') skip;
end;
return('1'b);
end getDataFromTCD152_ok ;
/**-----------------------------------------------------------------**/
/** 5.1 getPidClientIdFromTCD150_ok **/
/**-----------------------------------------------------------------**/
getPidClientIdFromTCD150_ok:
Proc ( $p_gpcif )
returns ( bit(1) aligned );
dcl $p_gpcif ptr ;
dcl 1 @gpcif based( $p_gpcif ) ,
3 i ,
5 userPid char( 8) ,
5 clientId char(10) ,
5 padd_01 char( 2) ,
3 o ,
5 hasFound bit(1)aligned ,
5 padd_01 char( 3) ,
5 traceLevel bin fixed(31) ,
5 getRegionName char( 1) ,
5 padd_02 char( 3) ,
3 endOfStruc char( 0) ;
dcl @isOk bit(1)aligned init('1'b);
if aux.isPutOn then
do;
call putFrame('start','getPidClientIdFromTCD150_ok' ,70);
end;
/**------------------------**/
/** Initializing Output **/
/**------------------------**/
do;
@gpcif.o.getRegionName = 'N' ;
@gpcif.o.hasFound = '0'b ;
end;
/**--------**/
/** open **/
/**--------**/
/* get all "Trace" */
if ^open_C_tracePidClientId_ok () then
do;
@isOk = '0'b;
end;
else
do;
/**---------**/
/** fetch **/
/**---------**/
dcl 1 @ftpc ,
3 i ,
5 userPid char( 8) init( '' ) ,
5 clientId char(10) init( '' ) ,
5 padd_01 char( 2) init( '' ) ,
3 o ,
5 hasFound bit ( 1) aligned init('0'b) ,
5 padd_01 char( 3) init( '' ) ,
5 uSwitch bin fixed(31) init( 0 ) ,
5 userPid char( 8) init( '' ) ,
5 clientId char(10) init( '' ) ,
5 padd_02 char( 2) init( '' ) ,
3 endOfStruc char( 0) init( '' ) ;
@ftpc.i.userPid = @gpcif.i.userPid ;
@ftpc.i.clientId = @gpcif.i.clientId ;
if ^Fetch_C_tracePidClientId_ok ( addr(@ftpc) ) then
do;
@isOk = '0'b;
end;
else
do;
@gpcif.o.hasFound = @ftpc.o.hasFound ;
if ( @gpcif.o.hasFound ) then
do;
aux.isPutOn = '1'b ;
@gpcif.o.traceLevel = 0 ;
@gpcif.o.getRegionName = 'Y' ;
end;
end; /* fetch */
end; /* open */
/**---------**/
/** close **/
/**---------**/
if ^close_C_tracePidClientId_ok () then
do;
@isOk = '0'b;
end;
if aux.isPutOn then
do;
call putR ('**' ,70);
call putR ('** hasFound . . . : ' ||
@gpcif.o.hasFound ,70);
call putR ('** traceLevel . . : ' ||
bin31_to_char(@gpcif.o.traceLevel) ,70);
call putR ('** getRegionName : ' ||
@gpcif.o.getRegionName ,70);
call putR ('** @isOk . . . . : ' ||
@isOk ,70);
call putFrame('end ','getPidClientIdFromTCD150_ok' ,70);
end;
return( @isOk ) ;
end /* getPidClientIdFromTCD150_ok */ ;
/**-----------------------------------------------------------------**/
/** 5.1 putTcd152_ok **/
/**-----------------------------------------------------------------**/
putTcd152_ok:
Proc
returns ( bit(1) aligned );
dcl @isOk bit(1)aligned init('1'b);
dcl @i bin fixed(31) init( 0 );
dcl @m bin fixed(31) init( 0 );
if aux.isPutOn then
do;
call putFrame ('start','putTcd152_ok' ,70);
call putR ('** Key' ,70);
call putR ('** serviceId . . . . : ' ||
tcd152.serviceId ,70);
call putR ('** Alternative Key' ,70);
call putR ('** operationName . . : ' ||
tcd152.operationName ,70);
call putR ('** interfaceName . . : ' ||
tcd152.interfaceName ,70);
call putR ('** pgmName . . . . . : ' ||
tcd152.pgmName ,70);
call putR ('** Trace-Level' ,70);
call putR ('** general' ,70);
call putR ('** traceLvlAll . . : ' ||
tcd152.traceLvlAll ,70);
call putR ('** getRegionAll . : ' ||
tcd152.getRegionAll ,70);
/**------------**/
/** pidStruc **/
/**------------**/
do;
call putR ('** pidStruc' ,70);
dcl
1 @pidStruc based( addr (tcd152.pid_01) ) ,
3 a(10) ,
5 pid char( 8) ,
5 clientId char(10) ,
5 traceLvl char( 1) ,
5 getRegion char( 1) ,
3 endOfStruc char( 0) ;
@m = hbound(@pidStruc.a,1) ;
do @i=1 to @m
while( @pidStruc.a(@i).pid ^= ''
| @pidStruc.a(@i).clientId ^= '' );
call putR ('** '||putIP(@i,@m) ,70);
call putR ('** pid . . . . . : ' ||
@pidStruc.a(@i).pid ,70);
call putR ('** clientId . . : ' ||
@pidStruc.a(@i).clientId ,70);
call putR ('** traceLvl . . : ' ||
@pidStruc.a(@i).traceLvl ,70);
call putR ('** getRegion . . : ' ||
@pidStruc.a(@i).getRegion ,70);
end; /* do @i=1 to @m */
if @i=1 then
do;
call putR ('** none available' ,70);
end;
end;
/**--------------**/
/** components **/
/**--------------**/
do;
call putR ('** components' ,70);
dcl
1 @components based( addr (tcd152.componentName_01) ) ,
3 a(10) ,
5 componentName char( 8) ,
5 componentTLvl char( 1) ,
3 endOfStruc char( 0) ;
@m = hbound(@components.a,1) ;
do @i=1 to @m
while( @components.a(@i).componentName ^= '' );
call putR ('** '||putIP(@i,@m) ,70);
call putR ('** componentName . : ' ||
@components.a(@i).componentName ,70);
call putR ('** componentTLvl . : ' ||
@components.a(@i).componentTLvl ,70);
end; /* do @i=1 to @m */
if @i=1 then
do;
call putR ('** none available' ,70);
end;
end;
/**--------------**/
/** clientIdA **/
/**--------------**/
do;
call putR ('** clientId allowed' ,70);
call putR ('** inOrExclude . . . : ' ||
tcd152.inOrExclude ,70);
dcl
1 @clientIdA based( addr (tcd152.clientIdA_01) ) ,
3 a(10) ,
5 clientIdA char(10) ,
3 endOfStruc char( 0) ;
@m = hbound(@components.a,1) ;
do @i=1 to @m
while( @clientIdA.a(@i).clientIdA ^= '' );
call putR ('** '||putIP(@i,@m) ,70);
call putR ('** clientIdA . . . : ' ||
@clientIdA.a(@i).clientIdA ,70);
end; /* do @i=1 to @m */
if @i=1 then
do;
call putR ('** none available' ,70);
end;
end;
/**--------------**/
/** forApplUse **/
/**--------------**/
do;
call putR ('** forApplUse' ,70);
dcl
1 @forApplUse based( addr (tcd152.forApplUse_01) ) ,
3 a( 3) ,
5 forApplUse char(200) ,
3 endOfStruc char( 0) ;
@m = hbound(@forApplUse.a,1) ;
do @i=1 to @m
while( @forApplUse.a(@i).forApplUse ^= '' );
call putR ('** '||putIP(@i,@m) ,70);
call putR ('** forApplUse . . : ' ||
@forApplUse.a(@i).forApplUse ,70);
end; /* do @i=1 to @m */
if @i=1 then
do;
call putR ('** none available' ,70);
end;
end;
/**--------------**/
/** date **/
/**--------------**/
do;
call putR ('** date' ,70);
call putR ('** currentTs . . . : ' ||
tcd152.currentTs ,70);
call putR ('** dayOfWeek . . . : ' ||
bin31_to_char(tcd152.dayOfWeek) ,70);
end;
call putFrame ('end ','putTcd152_ok' ,70);
end;
return( @isOk ) ;
end putTcd152_ok ;
/**-----------------------------------------------------------------**/
/** 5.01 fill_tcd153_struc_ok **/
/**-----------------------------------------------------------------**/
fill_tcd153_struc_ok:
Proc
returns ( bit(1) aligned );
dcl @isOk bit(1) aligned init('1'b);
if aux.isPutOn then
do;
call putFrame('start','fill_tcd153_struc_ok' ,70);
end;
tcd153.start_ts = CDPUT3_start_ts ;
tcd153.interfaceName = CDPUT3_interfaceName ;
tcd153.operationName = CDPUT3_operationName ;
tcd153.trx = CDPUT3_trxName ;
tcd153.pgmName = CDPUT3_pgmName ;
tcd153.clientId = CDPUT3_clientId ;
tcd153.pid = in.CDPUT3_pid ;
tcd153.traceLevel = bin31_to_char1(out.CDPUT3_traceLevel) ;
tcd153.duration_ts = getDifference( CDPUT3_start_ts
, CDPUT3_end_ts );
tcd153.serviceId = CDPUT3_serviceId ;
tcd153.forApplUse_01 = CDPUT3_153ForApplUse_01;
;
if aux.isPutOn then
do;
call putR ('** start_ts . . : ' ||
tcd153.start_ts ,70);
call putR ('** interfaceName : ' ||
tcd153.interfaceName ,70);
call putR ('** operationName : ' ||
tcd153.operationName ,70);
call putR ('** trx . . . . . : ' ||
tcd153.trx ,70);
call putR ('** pgmName . . . : ' ||
tcd153.pgmName ,70);
call putR ('** clientId . . : ' ||
tcd153.clientId ,70);
call putR ('** pid . . . . . : ' ||
tcd153.pid ,70);
call putR ('** traceLevel . : ' ||
tcd153.traceLevel ,70);
call putR ('** regionName . : ' ||
tcd153.regionName ,70);
call putR ('** jobNr . . . . : ' ||
tcd153.jobNr ,70);
call putR ('** duration_ts . : ' ||
tcd153.duration_ts ,70);
call putR ('** serviceId . . : ' ||
tcd153.serviceId ,70);
call putR ('** forApplUse_01 : ' ||
tcd153.forApplUse_01 ,70);
end;
if aux.isPutOn then
do;
call putFrame('end ','fill_tcd153_struc_ok' ,70);
end;
return( @isOk ) ;
end fill_tcd153_struc_ok ;
/**-----------------------------------------------------------------**/
/** 5.01 getDifference **/
/**-----------------------------------------------------------------**/
getDifference:
Proc ( $start_ts
, $end_ts )
returns ( char(26) );
dcl $start_ts char(26) ;
dcl @start_ts char(26) ;
dcl 1 @start based( addr(@start_ts) ) ,
3 yyyy pic'9999' ,
3 strich1 char(1) ,
3 mo pic'99' ,
3 strich2 char(1) ,
3 dd pic'99' ,
3 strich3 char(1) ,
3 hh pic'99' ,
3 punkt1 char(1) ,
3 mi pic'99' ,
3 punkt2 char(1) ,
3 ss pic'99' ,
3 punkt3 char(1) ,
3 mmmmmm pic'999999' ,
3 ende char(0) ;
dcl $end_ts char(26) ;
dcl @end_ts char(26) ;
dcl 1 @ende based( addr(@end_ts) ) ,
3 yyyy pic'9999' ,
3 strich1 char(1) ,
3 mo pic'99' ,
3 strich2 char(1) ,
3 dd pic'99' ,
3 strich3 char(1) ,
3 hh pic'99' ,
3 punkt1 char(1) ,
3 mi pic'99' ,
3 punkt2 char(1) ,
3 ss pic'99' ,
3 punkt3 char(1) ,
3 mmmmmm pic'999999' ,
3 ende char(0) ;
dcl @difference_ts char(26) init('') ;
dcl 1 @diff based( addr(@difference_ts) ) ,
3 yyyy pic'9999' ,
3 strich1 char(1) ,
3 mo pic'99' ,
3 strich2 char(1) ,
3 dd pic'99' ,
3 strich3 char(1) ,
3 hh pic'99' ,
3 punkt1 char(1) ,
3 mi pic'99' ,
3 punkt2 char(1) ,
3 ss pic'99' ,
3 punkt3 char(1) ,
3 mmmmmm pic'999999' ,
3 ende char(0) ;
dcl @isOk bit ( 1) aligned init('1'b);
@start_ts = $start_ts ;
@end_ts = $end_ts ;
@diff.yyyy = '0001' ;
@diff.strich1 = '-' ;
@diff.mo = '01' ;
@diff.strich2 = '-' ;
@diff.dd = '01' ;
@diff.strich3 = '-' ;
@diff.hh = '' ;
@diff.punkt1 = '.' ;
@diff.mi = '' ;
@diff.punkt2 = '.' ;
@diff.ss = '' ;
@diff.punkt3 = '.' ;
@diff.mmmmmm = '' ;
if aux.isPutOn then
do;
call putFrame('start','getDifference' ,80);
call putR ('** end_ts . . . . : ' ||
$end_ts ,80);
call putR ('** start_ts . . . : ' ||
$start_ts ,80);
end;
if ( @ende.mmmmmm - @start.mmmmmm >= 0 ) then
do;
@diff.mmmmmm = @ende.mmmmmm - @start.mmmmmm ;
end;
else
do;
@diff.mmmmmm = @ende.mmmmmm - @start.mmmmmm + 1000000 ;
@start.ss = @start.ss + 1 ;
end;
if ( @ende.ss - @start.ss >= 0 ) then
do;
@diff.ss = @ende.ss - @start.ss ;
end;
else
do;
@diff.ss = @ende.ss - @start.ss + 60 ;
@start.mi = @start.mi + 1 ;
end;
if ( @ende.mi - @start.mi >= 0 ) then
do;
@diff.mi = @ende.mi - @start.mi ;
end;
else
do;
@diff.mi = @ende.mi - @start.mi + 60 ;
@start.hh = @start.hh + 1 ;
end;
if ( @ende.hh - @start.hh >= 0 ) then
do;
@diff.hh = @ende.hh - @start.hh ;
end;
else
do;
@diff.hh = @ende.hh - @start.hh + 24 ;
@start.dd = @start.dd + 1 ;
end;
/**--------**/
/** Tage **/
/**--------**/
if ( @ende.dd ^= @start.dd ) then
do;
@isOk = '0'b;
end;
if ^@isOk then
do;
@difference_ts = '0001-01-01-00.00.01.000000' ;
end;
if aux.isPutOn then
do;
call putR ('** difference_ts . : ' ||
@difference_ts ,80);
call putFrame('end ','getDifference' ,80);
end;
return( @difference_ts ) ;
end getDifference ;
/**-----------------------------------------------------------------**/
/** 5.1 open_C_tracePidClientId_ok **/
/**-----------------------------------------------------------------**/
open_C_tracePidClientId_ok:
Proc
returns ( bit(1) aligned );
dcl @isOk bit(1) aligned init('1'b);
exec SQL open C_tracePidClientId ;
cPidClientOp = cPidClientOp + 1;
aux.C_tracePidClientId_open = '1'b ;
select (sqlca.sqlcode) ;
when ( 0 )
do;
/* wunderbar */
@isOk = '1'b ;
end;
otherwise
do;
aux.isPutOn = '1'b;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'open von C_tracePidClientId'
, '1010' /* traceId */
) then @isOk = '0'b ;
@isOk = '0'b ;
end;
end; /* select */
return( @isOk ) ;
end open_C_tracePidClientId_ok ;
/**-----------------------------------------------------------------**/
/** 5.1 open_C_tcd152_ok **/
/**-----------------------------------------------------------------**/
open_C_tcd152_ok:
Proc
returns ( bit(1) aligned );
dcl @isOk bit(1) aligned init('1'b);
call putFrame('start','open_C_tcd152_ok' ,70);
call putR ('** serviceId . . : ' ||
CDPUT3_serviceId ,70);
call putR ('** interfaceName : ' ||
CDPUT3_interfaceName ,70);
if noSql then
sqlCode = 0;
else
exec SQL open C_tcd152 ;
aux.C_tcd152_open = '1'b ;
select (sqlca.sqlcode) ;
when ( 0 )
do;
/* wunderbar */
@isOk = '1'b ;
end;
otherwise
do;
aux.isPutOn = '1'b;
CDPUT3_RC = 20 ;
call sqlErr(sourceLine(), 'open C_tcd152');
if is_DB2_Error
( addr( sqlca )
, 'open von C_tcd152'
, '1010' /* traceId */
) then @isOk = '0'b ;
@isOk = '0'b ;
end;
end; /* select */
call putFrame('end ','open_C_tcd152_ok' ,70);
return( @isOk ) ;
end open_C_tcd152_ok ;
/**-----------------------------------------------------------------**/
/** 5.1 close_C_tcd152_ok **/
/**-----------------------------------------------------------------**/
close_C_tcd152_ok:
Proc
returns ( bit(1) aligned );
dcl @isOk bit(1) aligned init('1'b);
/***********************/
/** Cursor C_tcd152 **/
/***********************/
if aux.C_tcd152_open then
do;
if noSql then
sqlCode = 0;
else
exec SQL close C_tcd152;
select (sqlca.sqlcode) ;
when ( 0 )
do;
/* wunderbar */
@isOk = '1'b ;
aux.C_tcd152_open = '0'b ;
end;
otherwise
do;
aux.isPutOn = '1'b;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'closing of C_tcd152'
, '1010' /* traceId */
) then @isOk = '0'b ;
@isOk = '0'b ;
end;
end; /* select */
end;
return( @isOk ) ;
end close_C_tcd152_ok ;
/**-----------------------------------------------------------------**/
/** 5.1 close_C_tracePidClientId_ok **/
/**-----------------------------------------------------------------**/
close_C_tracePidClientId_ok:
Proc
returns ( bit(1) aligned );
dcl @isOk bit(1) aligned init('1'b);
/**********************************/
/** Cursor C_tracePidClientId **/
/**********************************/
if aux.C_tracePidClientId_open then
do;
exec SQL close C_tracePidClientId;
cPidClientCl = cPidClientCL + 1;
select (sqlca.sqlcode) ;
when ( 0 )
do;
/* wunderbar */
@isOk = '1'b ;
aux.C_tracePidClientId_open = '0'b ;
end;
otherwise
do;
aux.isPutOn = '1'b;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'closing of C_tracePidClientId'
, '1010' /* traceId */
) then @isOk = '0'b ;
@isOk = '0'b ;
end;
end; /* select */
end;
return( @isOk ) ;
end close_C_tracePidClientId_ok ;
/**-----------------------------------------------------------------**/
/** 5.1 open_C_REGION_ok **/
/**-----------------------------------------------------------------**/
open_C_REGION_ok:
Proc
returns ( bit(1) aligned );
dcl @isOk bit(1) aligned init('1'b);
exec SQL open C_REGION;
aux.C_REGION_open = '1'b ;
select (sqlca.sqlcode) ;
when ( 0 )
do;
/* wunderbar */
@isOk = '1'b ;
end;
otherwise
do;
aux.isPutOn = '1'b;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'open von C_REGION'
, '1010' /* traceId */
) then @isOk = '0'b ;
@isOk = '0'b ;
end;
end; /* select */
return( @isOk ) ;
end open_C_REGION_ok ;
/**-----------------------------------------------------------------**/
/** 5.1 update_REGION_data_ok **/
/**-----------------------------------------------------------------**/
update_REGION_data_ok:
Proc
returns ( bit(1) aligned );
if aux.isPutOn then
do;
call putFrame('start'
,'update_REGION_data_ok' ,70);
end;
exec SQL
update TCD150A1
set CD150008 = current timestamp
, CD150011 = :CD150011
, CD150012 = :CD150012
where CD150001 = :CDPUT3_metaId
and CD150002 = 'REG'
and CD150003 = 'ION'
and CD150005 < :TimeStamp
and CD150006 >= :TimeStamp ;
if ( sqlca.sqlcode ^= 0 ) then
do;
aux.isPutOn = '1'b;
CDPUT3_RC = 20 ;
if is_DB2_Error
( addr( sqlca )
, 'Update Region-Data'
, '1010' /* traceId */
) then return('0'b);
end;
if aux.isPutOn then
do;
call putFrame('end '
,'update_REGION_data_ok' ,70);
end;
return('1'b) ;
end update_REGION_data_ok ;
/**-----------------------------------------------------------------**/
/** 5.1 fill_REGION_data_ok **/
/**-----------------------------------------------------------------**/
fill_REGION_data_ok:
Proc
returns ( bit(1) aligned );
dcl 1 feld_1 based( addr( cd150011 ) ) ,
3 r (6) , Yc
5 rName char( 8) , Yc
5 fill01 char( 1) , Yc
5 rId char( 8) , Yc
5 fill02 char( 1) , Yc
5 rPid char( 8) , Yc
5 fill03 char( 1) , Yc
5 rTime char( 12) , Yc
5 fill04 char( 1) , Yc
3 end char( 0) ; Yc
dcl 1 feld_2 based( addr( cd150012 ) ) ,
3 r (6) , Yc
5 rName char( 8) , Yc
5 fill01 char( 1) , Yc
5 rId char( 8) , Yc
5 fill02 char( 1) , Yc
5 rPid char( 8) , Yc
5 fill03 char( 1) , Yc
5 rTime char( 12) , Yc
5 fill04 char( 1) , Yc
3 end char( 0) ; Yc
if aux.isPutOn then
do;
call putFrame('start','fill_REGION_data_ok' ,70);
end;
dcl @i bin fixed(31) init(0);
call putR('** feld_2' ,70);
do @i=6 to 2 by -1 ;
feld_2(@i).rName = feld_2(@i-1).rName ;
feld_2(@i).rId = feld_2(@i-1).rId ;
feld_2(@i).rPid = feld_2(@i-1).rPid ;
feld_2(@i).rTime = feld_2(@i-1).rTime ;
if aux.isPutOn then
do;
call putR('** ' || bin31_to_char(@i) ,70);
call putR('** rName : ' ||
feld_2(@i).rName ,70);
call putR('** rId . : ' ||
feld_2(@i).rId ,70);
call putR('** rPid : ' ||
feld_2(@i).rPid ,70);
call putR('** rTime : ' ||
feld_2(@i).rTime ,70);
end;
end; /* next @i */
feld_2(1).rName = feld_1(6).rName ;
feld_2(1).rId = feld_1(6).rId ;
feld_2(1).rPid = feld_1(6).rPid ;
feld_2(1).rTime = feld_1(6).rTime ;
if aux.isPutOn then
do;
call putR('** 1' ,70);
call putR('** rName : ' ||
feld_2( 1).rName ,70);
call putR('** rId . : ' ||
feld_2( 1).rId ,70);
call putR('** rPid : ' ||
feld_2( 1).rPid ,70);
call putR('** rTime : ' ||
feld_2( 1).rTime ,70);
end;
call putR('**' ,70);
call putR('** feld_1' ,70);
do @i=6 to 2 by -1 ;
feld_1(@i).rName = feld_1(@i-1).rName ;
feld_1(@i).rId = feld_1(@i-1).rId ;
feld_1(@i).rPid = feld_1(@i-1).rPid ;
feld_1(@i).rTime = feld_1(@i-1).rTime ;
if aux.isPutOn then
do;
call putR('** ' || bin31_to_char(@i) ,70);
call putR('** rName : ' ||
feld_1(@i).rName ,70);
call putR('** rId . : ' ||
feld_1(@i).rId ,70);
call putR('** rPid : ' ||
feld_1(@i).rPid ,70);
call putR('** rTime : ' ||
feld_1(@i).rTime ,70);
end;
end; /* next @i */
if aux.isPutOn then
do;
call putR('** 1' ,70);
call putR('** rName : ' ||
feld_1( 1).rName ,70);
call putR('** rId . : ' ||
feld_1( 1).rId ,70);
call putR('** rPid : ' ||
feld_1( 1).rPid ,70);
call putR('** rTime : ' ||
feld_1( 1).rTime ,70);
end;
if ^update_REGION_data_ok () then return('0'b);
if aux.isPutOn then
do;
call putFrame('end ','fill_REGION_data_ok' ,70);
end;
return('1'b) ;
end fill_REGION_data_ok ;
1/**-----------------------------------------------------------------**/
/** 5.60 putFrame **/
/**-----------------------------------------------------------------**/
putFrame: proc( $type , $str , $pos);
dcl $type char(5);
dcl $str char(*);
dcl $pos bin fixed(31);
if ( aux.isPutOn ) then
do;
select ( $type ) ;
when ( 'start','Start','START')
do;
call putM(' ' ,$pos);
call putM('*' ,$pos);
call putR('** ' || $str ,$pos);
call putM('*' ,$pos);
call putR('**' ,$pos);
end;
otherwise
do;
call putR('**' ,$pos);
if $str ^= '' then
call putR('** End of ' || $str ,$pos);
call putR('**' ,$pos);
call putM('*' ,$pos);
end;
end; /* select ( $type ) */
end;
end putFrame ;
1/**-----------------------------------------------------------------**/
/** 5.57 is_DB2_Error **/
/**-----------------------------------------------------------------**/
is_DB2_Error: Proc ( $ptr_sqlca
, $text
, $traceId )
returns ( bit(1) aligned ) ;
dcl $ptr_sqlca ptr ;
dcl $text char(*) ;
dcl $traceId char(4) ;
dcl 1 @SQLCA based( $ptr_sqlca ) ,
%include sqlState ;
if @sqlca.sqlcode ^= 0 then
do;
if aux.isPutOn then
do;
call putM('*' ,70);
call putR('** SQL-Maske' ,70);
call putM('*' ,70);
call putR('** SQLCAID = '||@sqlca.SQLCAID ,70);
call putR('** SQLCABC = '||@sqlca.SQLCABC ,70);
call putR('** SQLCODE = '||@sqlca.sqlcode ,70);
call putR('** SQLERRM = '||@sqlca.SQLERRM ,70);
call putR('** SQLERRP = '||@sqlca.SQLERRP ,70);
call putR('** SQLERRD = '||@sqlca.SQLERRd(1) ,70);
call putR('** '||@sqlca.SQLERRd(2) ,70);
call putR('** '||@sqlca.SQLERRd(3) ,70);
call putR('** '||@sqlca.SQLERRd(4) ,70);
call putR('** '||@sqlca.SQLERRd(5) ,70);
call putR('** '||@sqlca.SQLERRd(6) ,70);
call putR('** SQLWARN = '||STRING(@sqlca.SQLWARN) ,70);
call putR('** SQLEXT = '||string(@sqlca.SQLEXT ) ,70);
call putM('*' ,70);
end;
end;
select ( @sqlca.sqlcode ) ;
when ( 0 )
do;
/* Kein Fehler */
end;
when ( 100 )
do;
/* Ist an anderer Stelle codiert. */
end;
when ( -805 )
do;
if aux.isPutOn then do;
call putM('*' ,60);
call putR('** sqlCode : -805' ,60);
call putR('** --------------' ,60);
call putR('** - DBRM nicht aktuell' ,60);
call putR('** - Collection-ID fehlt' ,60);
call putM('*' ,60);
end;
call raiseEx
( 'GLO00002'
, 'S'
, '1501'
, $traceId
, ''
, '' , '' , '' , ''
, addr(@sqlca) , null()
, 'DBRM nicht aktuell RC:-805'
);
return('1'b);
end;
when ( -904 , -923 , -924 )
do;
if aux.isPutOn then do;
call putM('*' ,60);
call putR('** DB2 nicht verfügbar RC:-904/-923/-924',60);
call putM('*' ,60);
end;
call raiseEx
( 'GLO00002'
, 'S'
, '1501'
, $traceId
, ''
, '' , '' , '' , ''
, addr(@sqlca) , null()
, $text||': DB2 nicht verfügbar RC:-904/-923/-924'
);
return('1'b);
end;
otherwise
do;
if aux.isPutOn then do;
call putM('*' ,60);
call putR('** '||$text||' DB2-Fehler RC=' ||
bin31_to_char( @sqlca.sqlcode ) ,60);
call putM('*' ,60);
end;
call raiseEx
( 'GLO00002'
, 'S'
, '1501'
, $traceId
, ''
, '' , '' , '' , ''
, addr(@sqlca) , null()
, $text || 'DB2-Fehler RC='
|| bin31_to_char( @sqlca.sqlcode )
);
return('1'b);
end;
end;
return('0'b);
end is_DB2_Error ;
1/**-----------------------------------------------------------------**/
/** 5.37 raiseEx **/
/**-----------------------------------------------------------------**/
raiseEx: Proc( @mainID
, @level
, @3270
, @traceId
, @ctx
, @param1Temp
, @param2Temp
, @param3Temp
, @param4Temp
, @pSQL
, @pIMS
, @textTemp
) ;
dcl @mainID char( 8) ;
dcl @level char( 1) ;
dcl @3270 char( 4) ;
dcl @traceId char( 4) ;
dcl @ctx char( 8) ;
dcl @param1Temp char( * ) ;
dcl @param1 char( 30) init('');
dcl @param2Temp char( * ) ;
dcl @param2 char( 30) init('');
dcl @param3Temp char( * ) ;
dcl @param3 char( 30) init('');
dcl @param4Temp char( * ) ;
dcl @param4 char( 30) init('');
dcl @pSQL ptr ;
dcl @pIMS ptr ;
dcl @textTemp char( * ) ;
dcl @text char(200) init('');
@param1 = substr( @param1Temp,1,min( 30,length(@param1Temp)) ) ;
@param2 = substr( @param2Temp,1,min( 30,length(@param2Temp)) ) ;
@param3 = substr( @param3Temp,1,min( 30,length(@param3Temp)) ) ;
@param4 = substr( @param4Temp,1,min( 30,length(@param4Temp)) ) ;
@text = substr( @textTemp ,1,min(200,length(@textTemp )) ) ;
/***************************************/
/* */
/* Exception wird nicht geschrieben. */
/* Es macht keinen Sinn, wenn yCDPUT3 */
/* Exceptions raised. */
/* */
/***************************************/
end raiseEx ;
/**-----------------------------------------------------------------**/
/** 5.05 Fill_CDADMIN_from_CDPUT **/
/**-----------------------------------------------------------------**/
Fill_CDADMIN_from_CDPUT:
proc ;
dcl @i bin fixed(31) init( 0 ) ;
if aux.isPutOn then
do;
call putFrame('start','Fill_CDADMIN_from_CDPUT' ,70);
call putR('** Folgende putFlags sind gesetzt:' ,70);
end;
/**------------------------------**/
/** Compatibility with YCDPUT1 **/
/**------------------------------**/
do;
if ( out.CDPUT3_traceLevel > 1 ) then
do;
aux.putFlag (1) = 'Y' ;
cdadmin.cdadmin_07(1) = 'Y' ;
end;
else
do;
aux.putFlag (1) = 'N' ;
cdadmin.cdadmin_07(1) = 'N' ;
end;
end;
/**--------------------------------**/
/** Umfüllen: CDPUT --> CDADMIN **/
/**--------------------------------**/
do @i=1 to 100;
select ( aux.putFlag(@i) ) ;
when ( 'Y' , 'y' , 'J' , 'j' )
do;
cdadmin.cdadmin_07(@i) = 'Y' ;
call putR('** -' || bin31_to_char3(@i) ||
'. eingeschaltet' ,70);
end;
when ( 'N' , 'n' )
do;
cdadmin.cdadmin_07(@i) = 'N' ;
call putR('** -' || bin31_to_char3(@i) ||
'. ausgeschaltet' ,70);
end;
otherwise
do;
/* no action */
end;
end; /* select */
end; /* next */
cdadmin_traceLevel = out.CDPUT3_traceLevel ;
cdadmin_compName( 1) = tcd152.componentName_01 ;
cdadmin_compName( 2) = tcd152.componentName_02 ;
cdadmin_compName( 3) = tcd152.componentName_03 ;
cdadmin_compName( 4) = tcd152.componentName_04 ;
cdadmin_compName( 5) = tcd152.componentName_05 ;
cdadmin_compName( 6) = tcd152.componentName_06 ;
cdadmin_compName( 7) = tcd152.componentName_07 ;
cdadmin_compName( 8) = tcd152.componentName_08 ;
cdadmin_compName( 9) = tcd152.componentName_09 ;
cdadmin_compName(10) = tcd152.componentName_10 ;
cdadmin_compTLvl( 1) = tcd152.componentTLvl_01 ;
cdadmin_compTLvl( 2) = tcd152.componentTLvl_02 ;
cdadmin_compTLvl( 3) = tcd152.componentTLvl_03 ;
cdadmin_compTLvl( 4) = tcd152.componentTLvl_04 ;
cdadmin_compTLvl( 5) = tcd152.componentTLvl_05 ;
cdadmin_compTLvl( 6) = tcd152.componentTLvl_06 ;
cdadmin_compTLvl( 7) = tcd152.componentTLvl_07 ;
cdadmin_compTLvl( 8) = tcd152.componentTLvl_08 ;
cdadmin_compTLvl( 9) = tcd152.componentTLvl_09 ;
cdadmin_compTLvl(10) = tcd152.componentTLvl_10 ;
if aux.isPutOn then
do;
call putFrame('end ','Fill_CDADMIN_from_CDPUT' ,70);
end;
end; /* Fill_CDADMIN_from_CDPUT */
1/**-----------------------------------------------------------------**/
/** 5.03 isHeading_ok MDL093 2008-03-19 **/
/**-----------------------------------------------------------------**/
isHeading_ok:
proc ( $moduleName
, $pid )
returns ( bit(1)aligned ) ;
dcl $moduleName char(8) ;
dcl $pid char(8) ;
dcl @isOk bit (1)aligned init('1'b) ;
if aux.isPutOn then
do;
call putM(' ' ,79);
call putM('*' ,79);
call putM('*' ,79);
call putR('**' ,79);
call putR('** Start of '||$moduleName||' on ' ||
translate('rbcd-ef-gh at ij:kl'
, datetime()
,'rbcdefghijklmnopq'
) ,79);
call putR('**' ,79);
call putM('*' ,79);
call putM('*' ,79);
call putM(' ' ,79);
call putM('*' ,79);
call putR('**' ,79);
call putR('** ' || COMP_VERS ,79);
call putR('** ' || COMP_TIME ,79);
call putR('**' ,79);
call putR('** PID : ' ||
$pid ,79);
call putR('**' ,79);
call putM('*' ,79);
end;
return( @isOk ) ;
end /* isHeading_ok */ ;
/**-----------------------------------------------------------------**/
/** 5.1 set_default_output_values_ok **/
/**-----------------------------------------------------------------**/
set_default_output_values_ok:
Proc
returns ( bit(1) aligned ) ;
if aux.isPutOn then
do;
call putFrame('start'
,'set_default_output_values_ok' ,70);
end;
/**-----------------**/
/** Default-Werte **/
/**-----------------**/
do;
yCDPUT3k.out.CDPUT3_rc = 0 ;
yCDPUT3k.out.CDPUT3_traceLevel = 0 ;
yCDPUT3k.out.CDPUT3_traceLevelModule = 0 ;
yCDPUT3k.out.CDPUT3_pid( * ) = '' ;
yCDPUT3k.out.CDPUT3_inOrExclude = '' ;
yCDPUT3k.out.CDPUT3_clientIdA (*) = '' ;
yCDPUT3k.out.CDPUT3_forApplUse(*) = '' ;
end;
if aux.isPutOn then
do;
call putFrame('end '
,'set_default_output_values_ok' ,70);
end;
return('1'b);
end set_default_output_values_ok ;
/**-----------------------------------------------------------------**/
/** 5.05 getTraceLevelForPgmName_ok **/
/**-----------------------------------------------------------------**/
getTraceLevelForPgmName_ok:
proc ( $ptr_itofpn )
returns( bit(1)aligned );
dcl $ptr_itofpn ptr ;
dcl
1 @itofpn based( $ptr_itofpn ) ,
3 i ,
5 traceLevelMainPgm bin fixed(31) ,
5 moduleName char(8) ,
3 o ,
5 traceLevel bin fixed(31) ,
3 endOfStruc char(0) ;
dcl @isOk bit (1)aligned init('1'b) ;
dcl @i bin fixed(31) init( 0 ) ;
if aux.isPutOn then
do;
call putFrame ('start','getTraceLevelForPgmName_ok' ,70);
call putR ('** moduleName . : ' ||
@itofpn.i.moduleName ,70);
call putR ('**' ,70);
call putR ('** traceLevel (general) : ' ||
bin31_to_char(@itofpn.i.traceLevelMainPgm) ,70);
end;
@itofpn.o.traceLevel = @itofpn.i.traceLevelMainPgm ;
/*
if ( @itofpn.o.traceLevel > 0 ) then
do;
*/
call putR ('**' ,70);
do @i=1 to 10
while (cdadmin_compName(@i) ^= @itofpn.i.moduleName);
end;
call putR ('** Search for moduleName ' ||
@itofpn.i.moduleName || ' in table ...' ,70);
if ( @i = 11 ) then
do;
call putR ('** ... moduleName ' ||
@itofpn.i.moduleName || ' not found in table' ,70);
if ( @itofpn.o.traceLevel > 0 ) then
do;
aux.isPutOn = '1'b;
call putR ('** Trace is on because of' ||
' traceLevelMainPgm : ' ||
bin31_to_char(@itofpn.i.traceLevelMainPgm) ,70);
end;
end;
else
do;
call putR ('** ... moduleName ' ||
@itofpn.i.moduleName || ' found in table' ,70);
select ( cdadmin_compTLvl(@i) );
when ( ' ' )
do;
call putR ('** ... no traceLevel specified' ,70);
end;
when ( '0','1','2','3','4','5','6','7','8','9' )
do;
@itofpn.o.traceLevel =
char1_to_bin31(cdadmin_compTLvl(@i),0);
if ( @itofpn.o.traceLevel > 0 ) then aux.isPutOn = '1'b;
call putR ('** traceLevel . : ' ||
cdadmin_compTLvl(@i) ,70);
end;
otherwise
do;
aux.isPutOn = '1'b;
call putR ('** ... wrong traceLevel specified : ' ||
cdadmin_compTLvl(@i) ,70);
end;
end; /* select */
end;
/*
end;
*/
if aux.isPutOn then
do;
call putR ('**' ,70);
call putR ('** traceLevel : ' ||
bin31_to_char(@itofpn.o.traceLevel) ,70);
call putFrame('end ','getTraceLevelForPgmName_ok' ,70);
end;
return( @isOk );
end /* getTraceLevelForPgmName_ok */ ;
CDADMINP
/**-----------------------------------------------------------------**/
/** 5.42 Footing **/
/**-----------------------------------------------------------------**/
Footing:
proc ( @pgmName ) ;
dcl @pgmName char(8) ;
if aux.isPutOn then
do;
call putM(' ' ,79);
call putM('*' ,79);
call putM('*' ,79);
call putR('**' ,79);
call putR('** End of '||@pgmName||' on ' ||
translate('gh.ef.rbcd at ij:kl'
, datetime()
,'rbcdefghijklmnopq'
) ,79);
call putR('**' ,79);
call putM('*' ,79);
call putM('*' ,79);
call putM(' ' ,79);
end;
end Footing ;
1/**-----------------------------------------------------------------**/
/** 5.38 putIP MDL153 2008-03-07 **/
/**-----------------------------------------------------------------**/
putIP:
proc( $i
, $m )
returns ( char(40)var );
dcl $i bin fixed(31) ;
dcl $m bin fixed(31) ;
dcl @out char (40)var init('') ;
@out = bin31_to_char($i) ||
' (Possible: ' ||
bin31_to_char($m) ||
')' ;
return(@out) ;
end; /* putIP */
/**-----------------------------------------------------------------**/
/** 5.42 getTraceRegionForPid **/
/**-----------------------------------------------------------------**/
getTraceRegionForPid:
proc ( $ptr_gtrfp )
returns ( bit(1)aligned );
dcl $ptr_gtrfp ptr ;
dcl
1 @gtrfp based ( $ptr_gtrfp) ,
3 i ,
5 pid char( 8) ,
3 o ,
5 hasFound bit ( 1)aligned ,
5 getRegion char( 1) ,
5 traceLevel bin fixed(31) ,
5 padd_01 char( 1) ,
3 endOfStruc char( 0) ;
dcl @i bin fixed(31) init(0) ;
dcl @m bin fixed(31) init(0) ;
dcl @isOk bit(1)aligned init('1'b);
call putFrame('start','getTraceRegionForPid' ,70);
call putR ('** input' ,70);
call putR ('** pid . . . : ' ||
@gtrfp.i.pid ,70);
/**------------**/
/** pidStruc **/
/**------------**/
do;
dcl
1 @pidStruc based( addr (tcd152.pid_01) ) ,
3 a(10) ,
5 pid char( 8) ,
5 clientId char(10) ,
5 traceLvl char( 1) ,
5 getRegion char( 1) ,
3 endOfStruc char( 0) ;
@m = hbound(@pidStruc.a,1) ;
do @i=1 to @m
while( @pidStruc.a(@i).pid ^= @gtrfp.i.pid ) ;
end;
if ( @pidStruc.a(@i).pid = @gtrfp.i.pid ) then
do;
@gtrfp.o.hasFound = '1'b ;
@gtrfp.o.getRegion = @pidStruc.a(@i).getRegion ;
@gtrfp.o.traceLevel = Char1_To_Bin31
( @pidStruc.a(@i).traceLvl , 0) ;
end;
else
do;
@gtrfp.o.hasFound = '0'b ;
end;
end;
if ( @gtrfp.o.traceLevel > 0 ) then
do;
aux.isPutOn = '1'b ;
call putR('** trace is switched on by explicit' ||
' userPid' ,70);
call putR('** on TCD152.' ,70);
call putR('** userPid : ' ||
@gtrfp.i.pid ,70);
end;
if ( aux.isPutOn ) then
do;
call putR ('** output' ,70);
call putR ('** hasFound . : ' ||
@gtrfp.o.hasFound ,70);
call putR ('** getRegion : ' ||
@gtrfp.o.getRegion ,70);
call putR ('** traceLevel : ' ||
bin31_to_char(@gtrfp.o.traceLevel) ,70);
call putFrame('end ','getTraceRegionForPid' ,70);
end;
return( @isOk );
end getTraceRegionForPid ;
/**-----------------------------------------------------------------**/
/** 5.42 getTraceRegionForClientId **/
/**-----------------------------------------------------------------**/
getTraceRegionForClientId:
proc ( $ptr_gtrfc )
returns ( bit(1)aligned );
dcl $ptr_gtrfc ptr ;
dcl
1 @gtrfc based ( $ptr_gtrfc) ,
3 i ,
5 clientId char(10) ,
3 o ,
5 hasFound bit ( 1)aligned ,
5 getRegion char( 1) ,
5 traceLevel bin fixed(31) ,
5 padd_01 char( 1) ,
3 endOfStruc char( 0) ;
dcl @i bin fixed(31) init(0) ;
dcl @m bin fixed(31) init(0) ;
dcl @isOk bit(1)aligned init('1'b);
call putFrame('start','getTraceRegionForClientId' ,70);
call putR ('** input' ,70);
call putR ('** clientId . : ' ||
@gtrfc.i.clientId ,70);
/**------------**/
/** pidStruc **/
/**------------**/
do;
dcl
1 @pidStruc based( addr (tcd152.pid_01) ) ,
3 a(10) ,
5 pid char( 8) ,
5 clientId char(10) ,
5 traceLvl char( 1) ,
5 getRegion char( 1) ,
3 endOfStruc char( 0) ;
@m = hbound(@pidStruc.a,1) ;
do @i=1 to @m
while( @pidStruc.a(@i).clientId ^= @gtrfc.i.clientId ) ;
end;
if ( @pidStruc.a(@i).clientId = @gtrfc.i.clientId
& @pidStruc.a(@i).clientId ^= '' ) then /* mn@20120913 */
do;
@gtrfc.o.hasFound = '1'b ;
@gtrfc.o.getRegion = @pidStruc.a(@i).getRegion ;
@gtrfc.o.traceLevel = Char1_To_Bin31
( @pidStruc.a(@i).traceLvl , 0) ;
end;
else
do;
@gtrfc.o.hasFound = '0'b ;
end;
end;
if ( @gtrfc.o.traceLevel > 0 ) then
do;
aux.isPutOn = '1'b ;
call putR('** trace is switched on by explicit' ||
' clientId' ,70);
call putR('** on TCD152.' ,70);
call putR('** clientId : ' ||
@gtrfc.i.clientId ,70);
end;
if ( aux.isPutOn ) then
do;
call putR ('** output' ,70);
call putR ('** hasFound . : ' ||
@gtrfc.o.hasFound ,70);
call putR ('** getRegion : ' ||
@gtrfc.o.getRegion ,70);
call putR ('** traceLevel : ' ||
bin31_to_char(@gtrfc.o.traceLevel) ,70);
call putFrame('end ','getTraceRegionForClientId' ,70);
end;
return( @isOk );
end getTraceRegionForClientId ;
1/**-----------------------------------------------------------------**/
/** 5.05 Char_To_Bin31 MDL155 2008-05-16 **/
/**-----------------------------------------------------------------**/
Char_To_Bin31:
proc ( $charVar
, $errorCd )
returns ( bin fixed (31) );
dcl $charVar char ( 5 ) varying ;
dcl $errorCd bin fixed(31) ;
dcl @bin31 bin fixed(31) init( 0 ) ;
dcl @char1 char(1) init( '') ;
dcl @char2 char(2) init( '') ;
/* This function converts char(1) to bin fixed(31) */
/* In case of a conversion error the value of $errorCd */
/* is returned. */
call putFrame('start','Char_To_Bin31' ,80);
call putR('$charVar 1 : ' ||
$charVar ,80);
$charVar = trim ( $charVar ) ;
call putR('$charVar 2 : ' ||
$charVar ,80);
Select ( length($charVar) ) ;
when ( 1 )
do;
@char1 = $charVar ;
@bin31 = Char1_To_Bin31 ( @char1 , $errorCd ) ;
end;
when ( 2 )
do;
@char2 = $charVar ;
@bin31 = Char2_To_Bin31 ( @char2 , $errorCd ) ;
end;
otherwise
do;
@bin31 = $errorCd ;
end;
end; /* Select ( length($charVar) ) */
call putR('@bin31 . : ' ||
@bin31 ,80);
call putFrame('end ','Char_To_Bin31' ,80);
return ( @bin31 ) ;
end ; /* Char_To_Bin31 */
1/**-----------------------------------------------------------------**/
/** 5.05 Char1_To_Bin31 MDL135 2007-08-13 **/
/**-----------------------------------------------------------------**/
Char1_To_Bin31:
proc ( $char1
, $errorCd )
returns ( bin fixed (31) );
dcl $char1 char ( 1 ) ;
dcl @pic1 pic '9' based(addr($char1));
dcl $errorCd bin fixed(31) ;
dcl @bin31 bin fixed(31) init(0) ;
/* This function converts char(1) to bin fixed(31) */
/* In case of a conversion error the value of $errorCd */
/* is returned. */
on conversion
begin;
@bin31 = $errorCd ;
goto ende;
end; /* conversion */
@bin31 = @pic1 ;
revert conversion ;
ende:
return ( @bin31 ) ;
end ; /* Char1_To_Bin31 */
1/**-----------------------------------------------------------------**/
/** 5.05 Char2_To_Bin31 MDL151 2008-05-16 **/
/**-----------------------------------------------------------------**/
Char2_To_Bin31:
proc ( $Char2
, $errorCd )
returns ( bin fixed (31) );
dcl $Char2 char ( 2 ) ;
dcl @picz9 pic'Z9' based (addr($Char2)) ;
dcl $errorCd bin fixed(31) ;
dcl @bin31 bin fixed(31) init(0) ;
/* This function converts char(1) to bin fixed(31) */
/* In case of a conversion error the value of $errorCd */
/* is returned. */
on conversion
begin;
@bin31 = $errorCd ;
goto ende;
end; /* conversion */
@bin31 = @picz9 ;
revert conversion ;
ende:
return ( @bin31 ) ;
end ; /* Char2_To_Bin31 */
1/**-----------------------------------------------------------------**/
/** 5.07 TraceLevel1TimeDifference_Ok MDL152 2008-09-17 **/
/**-----------------------------------------------------------------**/
TraceLevel1TimeDifference_Ok:
proc ( $point
, $prevTs
, $traceLevel )
returns ( bit(1) aligned );
dcl $point char( 25 ) ;
dcl $prevTs char( 26 ) ;
dcl $traceLevel bin fixed(31) ;
dcl @puts bit(1) aligned init('0'b);
dcl
1 @prevPic based(addr($prevTs)) ,
3 yyyy pic'9999' ,
3 mo pic '99' ,
3 dd pic '99' ,
3 hh pic '99' ,
3 mm pic '99' ,
3 ss pic '99' ,
3 ttt pic '999' ;
dcl @actTs char( 17 ) ;
dcl
1 @actPic based(addr(@actTs)) ,
3 yyyy pic'9999' ,
3 mo pic '99' ,
3 dd pic '99' ,
3 hh pic '99' ,
3 mm pic '99' ,
3 ss pic '99' ,
3 ttt pic '999' ;
dcl @difference char( 12 ) init('00:00:00:000') ;
dcl
1 @diffPic based(addr(@difference)) ,
3 hh pic '99' ,
3 fill_hh char(1) ,
3 mm pic '99' ,
3 fill_mm char(1) ,
3 ss pic '99' ,
3 fill_ss char(1) ,
3 ttt pic '999' ;
/**-------------------**/
/** Trace-Level = 1 **/
/**-------------------**/
if ( $traceLevel = 1 ) then
do;
@puts = aux.isPutOn ;
aux.isPutOn = '1'b ;
if ( $prevTs = '' ) then
do;
$prevTs = dateTime ;
call putM ('*' ,70);
call putR ('**' ,70);
call putR ('** Trace-Level 1' ,70);
call putR ('** =============' ,70);
call putR ('** Point TimeDifference' ,70);
call putR ('** ----- --------------' ,70);
call putR ('** Start ' ,70);
end;
do;
@actTs = dateTime ;
/** Thousendths of Seconds **/
/** ---------------------- **/
do;
if ( @actPic.ttt - @prevPic.ttt >= 0 ) then
do;
@diffPic.ttt = @actPic.ttt - @prevPic.ttt ;
end;
else
do;
@diffPic.ttt = 1000 + @actPic.ttt - @prevPic.ttt ;
@prevPic.ss = @prevPic.ss + 1 ;
end;
end;
/** Seconds **/
/** ------- **/
do;
if ( @actPic.ss - @prevPic.ss >= 0 ) then
do;
@diffPic.ss = @actPic.ss - @prevPic.ss ;
end;
else
do;
@diffPic.ss = 60 + @actPic.ss - @prevPic.ss ;
@prevPic.mm = @prevPic.mm + 1 ;
end;
end;
/** Minutes **/
/** ------- **/
do;
if ( @actPic.mm - @prevPic.mm >= 0 ) then
do;
@diffPic.mm = @actPic.mm - @prevPic.mm ;
end;
else
do;
@diffPic.mm = 60 + @actPic.mm - @prevPic.mm ;
@prevPic.hh = @prevPic.hh + 1 ;
end;
end;
/** Hours **/
/** ----- **/
do;
if ( @actPic.hh - @prevPic.hh >= 0 ) then
do;
@diffPic.hh = @actPic.hh - @prevPic.hh ;
end;
else
do;
@diffPic.hh = 60 + @actPic.hh - @prevPic.hh ;
@prevPic.dd = @prevPic.dd + 1 ;
end;
end;
call putR ('** ' || $point || @difference ,70);
$prevTs = @actTs ;
end;
aux.isPutOn = @puts ;
end;
return('1'b);
end /* TraceLevel1TimeDifference_Ok */ ;
/**-----------------------------------------------------------------**/
/** 5.42 processType_1 **/
/**-----------------------------------------------------------------**/
processType_1:
proc
returns ( bit(1)aligned );
dcl @isOk bit(1)aligned init('1'b);
call putFrame('start','processType_1' ,70);
/**-------------------**/
/** Initialization **/
/**-------------------**/
do;
out.CDPUT3_rc = 0 ;
out.CDPUT3_traceLevel = 0 ;
out.CDPUT3_fillTcd153 = 'N' ;
out.CDPUT3_pid(*) = '' ;
out.CDPUT3_inOrExclude = '' ;
out.CDPUT3_clientIdA(*) = '' ;
out.CDPUT3_forApplUse(*) = '' ;
tcd152 = '' ;
end;
/* Am Anfang wegen cdadmin_sysprint */
if plausi_input_fields_ok () then
do;
if set_default_output_values_ok () then
do;
/**------------------------**/
/** getDataFromTCD152_ok **/
/**------------------------**/
dcl 1 @getTcd152 ,
3 i ,
5 dummy char( 0) init('') ,
3 o ,
5 getRegionName char( 1) init('') ,
5 hasFound bit(1)aligned init('') ,
5 padd_01 char( 2) init('') ,
5 end char( 0) init('') ;
if ^getDataFromTCD152_ok (addr(@getTcd152)) then
do;
@isOk = '0'b ;
CDPUT3_rc = 99 ;
end;
else
do;
/**----------------------------**/
/** insert_missing_tcd152_ok **/
/**----------------------------**/
if ^@getTcd152.o.hasFound then
do;
end;
if ( @getTcd152.o.hasFound
& @isOk ) then
do;
/* not necessary. see below |
out.CDPUT3_traceLevel = tcd152.traceLvlAll ;
out.CDPUT3_fillTcd153 = tcd152.getRegionAll ;
*/
/**------------------------**/
/** getTraceRegionForPid **/
/**------------------------**/
dcl
1 @gtrfp ,
3 i ,
5 pid char( 8) init( '' ) ,
3 o ,
5 hasFound bit ( 1)aligned init('0'b) ,
5 getRegion char( 1) init( '' ) ,
5 traceLevel bin fixed(31) init( 0 ) ,
5 padd_01 char( 1) init( '' ) ,
3 endOfStruc char( 0) init( '' ) ;
@gtrfp.i.pid = in.CDPUT3_pid ;
if ^getTraceRegionForPid (addr(@gtrfp)) then
do;
@isOk = '0'b ;
CDPUT3_rc = 99 ;
end;
else
do;
if ( @gtrfp.o.hasFound ) then
do;
call putR('**' ,70);
call putR('** PID found -> ' ||
'no need to check Client-IDs' ,70);
call putR('**' ,70);
out.CDPUT3_traceLevel = @gtrfp.o.traceLevel ;
out.CDPUT3_fillTcd153 = @gtrfp.o.getRegion ;
end;
else
do;
/**-----------------------------**/
/** getTraceRegionForClientId **/
/**-----------------------------**/
dcl
1 @gtrfc ,
3 i ,
5 clientId char(10) init( '' ) ,
3 o ,
5 hasFound bit ( 1)aligned init('0'b) ,
5 getRegion char( 1) init( '' ) ,
5 traceLevel bin fixed(31) init( '' ) ,
5 padd_01 char( 1) init( '' ) ,
3 endOfStruc char( 0) init( '' ) ;
@gtrfc.i.clientId = in.CDPUT3_clientId ;
if ^getTraceRegionForClientId (addr(@gtrfc)) then
do;
@isOk = '0'b ;
CDPUT3_rc = 99 ;
end;
else
do;
if ( @gtrfc.o.hasFound ) then
do;
out.CDPUT3_traceLevel = @gtrfc.o.traceLevel ;
out.CDPUT3_fillTcd153 = @gtrfc.o.getRegion ;
end;
else
do;
out.CDPUT3_traceLevel =
Char1_To_Bin31( tcd152.traceLvlAll , 0) ;
out.CDPUT3_fillTcd153 = tcd152.getRegionAll ;
if ( out.CDPUT3_traceLevel > 0 ) then
do;
aux.isPutOn = '1'b ;
call putR('** trace is switched on by' ||
' type "all"' ,70);
end;
end;
end;
end;
end;
end;
end; /* getDataFromTCD152_ok */
end; /* set_default_output_values_ok */
end; /* plausi_input_fields_ok */
if ( out.CDPUT3_traceLevel = 0 ) then
do;
/**--------------------------------**/
/** getPidClientIdFromTCD150_ok **/
/**--------------------------------**/
if TraceLevel1TimeDifference_Ok
( 'before TCD150'
, aux.ts /* by reference */
, in.CDPUT3_traceLevel
) then;
do; /* getPidClientIdFromTCD150_ok */
dcl 1 @gpcif ,
3 i ,
5 pid char( 8) init('') ,
5 clientId char(10) init('') ,
5 padd_01 char( 2) init('') ,
3 o ,
5 hasFound bit(1)aligned init('') ,
5 padd_01 char( 3) init('') ,
5 traceLevel bin fixed(31) init( 0) ,
5 getRegionName char( 1) init('') ,
5 padd_02 char( 3) init('') ,
5 endOfStruc char( 0) init('') ;
@gpcif.i.pid = in.CDPUT3_pid ;
@gpcif.i.clientId = CDPUT3_clientId ;
if ^getPidClientIdFromTCD150_ok (addr(@gpcif)) then
do;
@isOk = '0'b ;
CDPUT3_rc = 99 ;
end;
else
do;
if ( @gpcif.o.hasFound ) then
do;
call putR('**' ,70);
call putR('** Trace on for all services.' ,70);
call putR('**' ,70);
out.CDPUT3_traceLevel = @gpcif.o.traceLevel ;
out.CDPUT3_fillTcd153 = @gpcif.o.getRegionName ;
end;
end;
end; /* getPidClientIdFromTCD150_ok */
if TraceLevel1TimeDifference_Ok
( 'after TCD150'
, aux.ts /* by reference */
, in.CDPUT3_traceLevel
) then;
end;
call Fill_CDADMIN_from_CDPUT ;
if ( isFlagOn(out.CDPUT3_filltcd153) ) then
do;
if fill_tcd153_struc_ok () then
do;
end; /* fill_tcd153_struc_ok */
end;
dcl @i bin fixed(31) init(0);
if aux.isPutOn then
do;
call putR ('**' ,70);
call putR ('** output' ,70);
call putR ('** rc . . . . . . . : ' ||
bin31_to_char(out.CDPUT3_rc) ,70);
call putR ('** traceLevel . . . : ' ||
bin31_to_char(out.CDPUT3_traceLevel) ,70);
call putR ('** fillTcd153 . . . : ' ||
out.CDPUT3_fillTcd153 ,70);
call putR ('** clientId' ,70);
call putR ('** inOrExclude . . : ' ||
out.CDPUT3_inOrExclude ,70);
call putR ('** clientIdA' ,70);
do @i=1 to 10 while( out.CDPUT3_clientIdA(@i)^='');
call putR ('** ' || putIP(@i,10) ,70);
call putR ('** clientIdA . : ' ||
out.CDPUT3_clientIdA (@i) ,70);
end;
if @i=1 then
do;
call putR ('** none' ,70);
end;
call putR ('** forApplUse' ,70);
do @i=1 to 3;
call putR ('** ' || putIP(@i,3) ,70);
call putR ('** forApplUse . : ' ||
out.CDPUT3_forApplUse(@i) ,70);
end;
call putR ('** CDADMIN' ,70);
call putR ('** traceLevel . . : ' ||
bin31_to_char(cdadmin_traceLevel) ,70);
call putFrame('end ','processType_1' ,70);
end;
return( @isOk );
end processType_1 ;
1/**-----------------------------------------------------------------**/
/** 5.40 isFlagOn MDL184 2010-05-07 **/
/**-----------------------------------------------------------------**/
isFlagOn:
proc ( $char_1 )
returns( bit(1) );
dcl $char_1 char(1) ;
if ( $char_1 = 'Y'
| $char_1 = 'y'
| $char_1 = 'J'
| $char_1 = 'j' ) then
do;
return('1'b);
end;
else
do;
return('0'b);
end;
end /* isFlagOn */ ;
/**-----------------------------------------------------------------**/
/** 5.42 processType_3 **/
/**-----------------------------------------------------------------**/
processType_3:
proc returns( bit(1)aligned );
dcl @isOk bit(1)aligned init('1'b);
if aux.isPutOn then
do;
call putFrame('start','processType_3' ,70);
end;
/* Am Anfang wegen cdadmin_sysprint */
if plausi_input_fields_ok () then
do;
call putR ('** fillTcd153 : ' ||
in.CDPUT3_filltcd153 ,70);
if ( isFlagOn(in.CDPUT3_filltcd153) ) then
do;
if fill_tcd153_struc_ok () then
do;
end; /* fill_tcd153_struc_ok */
if ( yCDPUT3k.CDPUT3_isExpress ) then
do;
end;
else
do;
end;
end;
end;
if aux.isPutOn then
do;
call putFrame('end ','processType_3' ,70);
end;
return ( @isOk ) ;
end processType_3 ;
/**-----------------------------------------------------------------**/
/** 5.42 processType_2 **/
/**-----------------------------------------------------------------**/
processType_2:
proc
returns ( bit(1)aligned ) ;
dcl @isOk bit(1)aligned init('1'b);
/* Am Anfang wegen cdadmin_sysprint */
if plausi_input_fields_ok () then
do;
/* darf nicht ausgeführt werden.
applUse wird überschrieben.
if set_default_output_values_ok () then
do; */
if (in.CDPUT3_ptrCdadmin = null()) then
do;
yCDPUT3k.out.CDPUT3_traceLevelModule = 0 ;
end;
else
do;
dcl
1 @itofpn ,
3 i ,
5 traceLevelMainPgm bin fixed(31) init('') ,
5 moduleName char(8) init('') ,
3 o ,
5 traceLevel bin fixed(31) init( 0) ,
3 endOfStruc char(0) init('') ;
@itofpn.i.traceLevelMainPgm = cdadmin_traceLevel ;
@itofpn.i.moduleName = CDPUT3_pgmName ;
if ( getTraceLevelForPgmName_ok(addr( @itofpn ))) then
do;
yCDPUT3k.out.CDPUT3_traceLevelModule = @itofpn.o.traceLevel ;
end;
else
do;
yCDPUT3k.out.CDPUT3_traceLevelModule = 0 ;
end;
end;
/*
end; /* set_default_output_values_ok */
end; /* plausi_input_fields_ok */
dcl @i bin fixed(31) init(0);
if aux.isPutOn then
do;
call putR ('**' ,70);
call putR ('** output for ' || @itofpn.i.moduleName ,70);
call putR ('** rc . . . . : ' ||
bin31_to_char(out.CDPUT3_rc) ,70);
call putR ('** traceLevel : ' ||
bin31_to_char(out.CDPUT3_traceLevelModule) ,70);
end;
return ( @isOk );
end processType_2 ;
selectTcd152Into: proc;
tcd152.SERVICEID = '???';
tcd152.INTERFACENAME = '???';
if noSql then
sqlCode = 0;
else
exec sql
select %include TCD152F;
, current timestamp
, dayOfWeek( current date )
into :TCD152
from TCD152A1
where serviceId = :CDPUT3_serviceId
and interfaceName = :CDPUT3_interfaceName
;
if sqlCode = 0 then do
c152SelInto = c152SelInto + 1;
if tcd152.SERVICEID <> CDPUT3_serviceId & ^noSql then
put ('sId <>' || tcd152.SERVICEID
|| '<>' || cdPut3_SERVICEID) skip;
if tcd152.interfaceName <> CDPUT3_interfaceName & ^noSql then
put ('sId <>' || tcd152.interfaceName
|| '<>' || cdPut3_interfaceName) skip;
end;
else do;
call sqlErr(sourceLine(), 'selectTcd152Into');
end ;
end selectTcd152Into;
selectPidClientInto:
Proc ( $p_ftpc )
returns ( bit(1) aligned );
dcl $p_ftpc ptr ;
dcl 1 @ftpc based ($p_ftpc) ,
3 i ,
5 userPid char( 8) ,
5 clientId char(10) ,
5 padd_01 char( 2) ,
3 o ,
5 hasFound bit ( 1) aligned ,
5 padd_01 char( 3) ,
5 uSwitch bin fixed(31) ,
/* 1 : userPid found */
/* 2 : clientId found */
5 userPid char( 8) ,
5 clientId char(10) ,
5 padd_02 char( 2) ,
3 endOfStruc char( 0) ;
exec SQL
select %include TCD150F;
into :TCD150
from TCD150A1
where CD150001 = 'TRACE'
and
( ( CD150002 = 'CLIE'
and CD150003 = 'NTID'
)
or
(
CD150002 = 'PID '
and CD150003 = ' '
)
)
and
( substr(cd150011, 1, 8) = :@ftpc.i.userPid
or substr(cd150011, 1, 10) = :@ftpc.i.clientId
)
and CD150005 < :TimeStamp
and CD150006 >= :TimeStamp
fetch first 1 row only
;
cPidClientInto = cPidClientInto + 1;
select ( sqlca.sqlcode ) ;
when ( 0 )
do;
select;
when ( @ftpc.i.userPid = substr(tcd150.cd150011,1,8) )
do;
@ftpc.o.hasFound = '1'b ;
@ftpc.o.uSwitch = 1 ;
@ftpc.o.userPid = substr(tcd150.cd150011,1,8) ;
aux.isPutOn = '1'b ;
call putR('** getRegionName is switched on by' ||
' userPid' ,70);
call putR('** on TCD150.' ,70);
end;
when ( @ftpc.i.clientId = substr(tcd150.cd150011,1,10) )
do;
@ftpc.o.hasFound = '1'b ;
@ftpc.o.uSwitch = 2 ;
@ftpc.o.clientId = substr(tcd150.cd150011,1,10) ;
aux.isPutOn = '1'b ;
call putR('** getRegionName is switched on by' ||
' clientId' ,70);
call putR('** on TCD150.' ,70);
end;
otherwise
do;
put ('pidClient bad row found |||||') skip;
return ('0'b);
end;
end; /* select */
end;
when ( 100 )
do;
@ftpc.o.hasFound = '0'b;
end;
otherwise
do;
call sqlErr(sourceLine(), 'selectPidClientInto');
end;
end; /* select sqlCode */
return ('1'b);
end selectPidClientInto;
selectPidClientIxOnly:
Proc ( $p_ftpc )
returns ( bit(1) aligned );
dcl $p_ftpc ptr ;
dcl 1 @ftpc based ($p_ftpc) ,
3 i ,
5 userPid char( 8) ,
5 clientId char(10) ,
5 padd_01 char( 2) ,
3 o ,
5 hasFound bit ( 1) aligned ,
5 padd_01 char( 3) ,
5 uSwitch bin fixed(31) ,
/* 1 : userPid found */
/* 2 : clientId found */
5 userPid char( 8) ,
5 clientId char(10) ,
5 padd_02 char( 2) ,
3 endOfStruc char( 0) ;
exec SQL
select cd150011
into :tcd150.cd150011
from TCD150A1
where CD150001 = 'TRACE'
and
( ( CD150002 = 'CLIE'
and CD150003 = 'NTID'
)
or
(
CD150002 = 'PID '
and CD150003 = ' '
)
)
and
( substr(cd150011, 1, 8) = :@ftpc.i.userPid
or substr(cd150011, 1, 10) = :@ftpc.i.clientId
)
and CD150005 < :TimeStamp
and CD150006 >= :TimeStamp
fetch first 1 row only
;
cPidClientInto = cPidClientInto + 1;
select ( sqlca.sqlcode ) ;
when ( 0 )
do;
select;
when ( @ftpc.i.userPid = substr(tcd150.cd150011,1,8) )
do;
@ftpc.o.hasFound = '1'b ;
@ftpc.o.uSwitch = 1 ;
@ftpc.o.userPid = substr(tcd150.cd150011,1,8) ;
aux.isPutOn = '1'b ;
call putR('** getRegionName is switched on by' ||
' userPid' ,70);
call putR('** on TCD150.' ,70);
end;
when ( @ftpc.i.clientId = substr(tcd150.cd150011,1,10) )
do;
@ftpc.o.hasFound = '1'b ;
@ftpc.o.uSwitch = 2 ;
@ftpc.o.clientId = substr(tcd150.cd150011,1,10) ;
aux.isPutOn = '1'b ;
call putR('** getRegionName is switched on by' ||
' clientId' ,70);
call putR('** on TCD150.' ,70);
end;
otherwise
do;
put ('pidClient bad row found |||||') skip;
return ('0'b);
end;
end; /* select */
end;
when ( 100 )
do;
@ftpc.o.hasFound = '0'b;
end;
otherwise
do;
call sqlErr(sourceLine(), 'selectPidClientInto');
end;
end; /* select sqlCode */
return ('1'b);
end selectPidClientIxOnly;
/*
sqlConnect__________________________________________________________*/
%include yxrrsaf;
sqlConnect:proc();
dcl ssid char(04) init('DBOF');
dcl plan char(08) init('QZTEST');
if yxrrsaf('CONNECT',ssid,plan) ^= 0 then
put('QZPLB'
,'Error in YXRRSAF Call'
,'SSID - '||ssid
,'PLAN - '||plan);
end sqlConnect;
/*
commit_______________________________________________________________*/
sql_commit: proc();
if noCommit then
return;
if yxrrsaf('COMMIT') ^= 0 then
put('QZPLB'
,'Error in YXRRSAF Commit Call');
cCommit = cCommit + 1;
end sql_commit;
sql_rollback: proc();
if yxrrsaf('ROLLBACK') ^= 0 then
put('QZPLB'
,'Error in YXRRSAF ROLLBACK Call');
end sql_rollback;
DCL DSNTIAR ENTRY EXTERNAL OPTIONS(ASM INTER RETCODE);
sqlMsg: proc ();
DCL MSGWIDTH FIXED BIN(31) INIT(72);
DCL MSGBLEN FIXED BIN(15) INIT(20); /* MAX # SQL MESSAGES */
DCL i FIXED BIN(31) INIT(0);
DCL 01 MESSAGE /* MESSAGE RETURN BUFFER */
, 02 MESSAGEL FIXED BIN(15) INIT(1440) /* BUFFER LENGTH */
, 02 MESSAGET(MSGBLEN) CHAR(msgWidth) INIT((*)' ') /* TEXT */
;
/* NOW PRINT OUT SQL STATEMENT RESULTS VIA DSNTIAR */
CALL DSNTIAR(SQLCA,MESSAGE,MSGWIDTH);
IF PLIRETV ^= 0 THEN DO; /* IF THE RETURN CODE ISN'T ZERO@08*/
/* ISSUE AN ERROR MESSAGE @08*/
PUT EDIT (' RETURN CODE ', PLIRETV, /* @08*/
' FROM MESSAGE ROUTINE DSNTIAR.') /* @08*/
(COL(1), A(13), F(8), A(30)); /* ISSUE THE MESSAGE @08*/
END; /* END ISSUE AN ERROR MESSAGE @08*/
DO I = 1 TO MSGBLEN /* @08*/
WHILE (MESSAGET(I) ^= ''); /* @08*/
PUT EDIT ( MESSAGET(I) ) (COL(1), A(msgWIdth)); /* @08*/
END; /* @08*/
end SqlMsg;
sqlErr: proc (lNo, txt);
DCL lNo FIXED BIN(31);
dcl txt char(500) varying;
put ('error at ' || trim(edit(lNo, 'ZZZZZZZZZ9'))
|| ': ' || txt) skip;
call sqlMsg;
call sql_rollback;
put ('error signal error') skip;
signal error;
end sqlErr;
1/**-----------------------------------------------------------------**/
/** **/
/** 6.0 M a i n - L o g i c **/
/** **/
/**-----------------------------------------------------------------**/
put ('start qzCdPut parm=' || $parm || ',le', length($parm)) skip;
IF LENGTH($parm) >= 1 then
fun = substr($parm, 1, 1);
else
fun = 'A';
IF LENGTH($parm) >= 2 then
IF substr($parm, 2, 1) = '0' then
noSql = '1'b ;
put edit(' fun=', fun, ' noSql=', noSql)
(a(8), a(1), a(7), b(1)) skip;
call sqlConnect ;
if fun = 'A' then do;
put edit ('52max ', tcd152KeysMax) (a(20), f(5)) skip;
do tcd152KeysIx=1 to tcd152KeysRep;
tcd152KeysJx = tcd152KeysJx + tcd152KeysStep;
if (tcd152KeysJx > tcd152KeysMax) then
tcd152KeysJx = tcd152KeysJx - tcd152KeysMax;
put edit (tcd152KeysIx, ' jx=', tcd152KeysJx
, ' s=', tcd152key(tcd152KeysJx).SERVICEID
, ' i=', tcd152key(tcd152KeysJx).INTERFACENAME)
(f(6), a(4), f(4), a(3), a(20), a(3), a(30)) skip;
end;
end;
else if fun = 'E' then do;
put edit ('52max ', tcd152KeysMax) (a(20), f(5)) skip;
do tcd152KeysIx=1 to tcd152KeysRep;
tcd152KeysJx = tcd152KeysJx + tcd152KeysStep;
if (tcd152KeysJx > tcd152KeysMax) then
tcd152KeysJx = tcd152KeysJx - tcd152KeysMax;
CDPUT3_interfaceName = tcd152key(tcd152KeysJx).INTERFACENAME;
CDPUT3_serviceId = tcd152key(tcd152KeysJx).SERVICEID;
if ( getDataFromTCD152_ok(tcd152KeysPtr) ) then ;
call sql_commit;
end;
put edit(c152Found, ' tcd152 open/fetch/close')
(f(9), a(50)) skip;
end;
else if fun = 'F' then do;
put edit ('52max ', tcd152KeysMax) (a(20), f(5)) skip;
do tcd152KeysIx=1 to tcd152KeysRep;
tcd152KeysJx = tcd152KeysJx + tcd152KeysStep;
if (tcd152KeysJx > tcd152KeysMax) then
tcd152KeysJx = tcd152KeysJx - tcd152KeysMax;
CDPUT3_interfaceName = tcd152key(tcd152KeysJx).INTERFACENAME;
CDPUT3_serviceId = tcd152key(tcd152KeysJx).SERVICEID;
call selectTCD152Into ;
call sql_commit;
end;
put edit(c152selInto, ' tcd152 select Into')
(f(9), a(50)) skip;
end;
else if fun = 'P' then do;
put edit ('52max ', tcd152KeysMax) (a(20), f(5)) skip;
do tcd152KeysIx=1 to tcd152KeysRep;
tcd152KeysJx = tcd152KeysJx + tcd152KeysStep;
if (tcd152KeysJx > tcd152KeysMax) then
tcd152KeysJx = tcd152KeysJx - tcd152KeysMax;
ttgpcif.i.userPid = tcd152key(tcd152KeysJx).INTERFACENAME;
ttgpcif.i.clientId = tcd152key(tcd152KeysJx).SERVICEID;
if ^getPidClientIdFromTCD150_ok (addr(ttgpcif)) then
cPidClientErr = cPidClientErr + 1;
else if ttgpcif.o.hasFound then
cPidClientFound = cPidClientFound + 1;
else
cPidClientNoFo = cPidClientNoFo + 1;
call sql_commit;
end;
put edit(cPidClientNoFo , ' pidClient notFound')
(f(9), a(50)) skip;
put edit(cPidClientErr , ' pidClient error')
(f(9), a(50)) skip;
put edit(cPidClientFound, ' pidClient found')
(f(9), a(50)) skip;
put edit(cPidClientOp, ' pidClient open')
(f(9), a(50)) skip;
put edit(cPidClientF1, ' pidClient fetch 1')
(f(9), a(50)) skip;
put edit(cPidClientF2, ' pidClient fetch 2')
(f(9), a(50)) skip;
put edit(cPidClientCl, ' pidClient close')
(f(9), a(50)) skip;
end;
else if fun = 'Q' then do;
put edit ('52max ', tcd152KeysMax) (a(20), f(5)) skip;
do tcd152KeysIx=1 to tcd152KeysRep;
tcd152KeysJx = tcd152KeysJx + tcd152KeysStep;
if (tcd152KeysJx > tcd152KeysMax) then
tcd152KeysJx = tcd152KeysJx - tcd152KeysMax;
ttgpcif.i.userPid = tcd152key(tcd152KeysJx).INTERFACENAME;
ttgpcif.i.clientId = tcd152key(tcd152KeysJx).SERVICEID;
if ^ selectPidClientInto (addr(ttgpcif)) then
cPidClientErr = cPidClientErr + 1;
else if ttgpcif.o.hasFound then
cPidClientFound = cPidClientFound + 1;
else
cPidClientNoFo = cPidClientNoFo + 1;
call sql_commit;
end;
put edit(cPidClientNoFo , ' pidClient notFound')
(f(9), a(50)) skip;
put edit(cPidClientErr , ' pidClient error')
(f(9), a(50)) skip;
put edit(cPidClientFound, ' pidClient found')
(f(9), a(50)) skip;
put edit(cPidClientInto, ' pidClient select into')
(f(9), a(50)) skip;
end;
else if fun = 'R' then do;
put edit ('52max ', tcd152KeysMax) (a(20), f(5)) skip;
do tcd152KeysIx=1 to tcd152KeysRep;
tcd152KeysJx = tcd152KeysJx + tcd152KeysStep;
if (tcd152KeysJx > tcd152KeysMax) then
tcd152KeysJx = tcd152KeysJx - tcd152KeysMax;
ttgpcif.i.userPid = tcd152key(tcd152KeysJx).INTERFACENAME;
ttgpcif.i.clientId = tcd152key(tcd152KeysJx).SERVICEID;
if ^ selectPidClientIxOnly (addr(ttgpcif)) then
cPidClientErr = cPidClientErr + 1;
else if ttgpcif.o.hasFound then
cPidClientFound = cPidClientFound + 1;
else
cPidClientNoFo = cPidClientNoFo + 1;
call sql_commit;
end;
put edit(cPidClientNoFo , ' pidClient ixOnly notFound')
(f(9), a(50)) skip;
put edit(cPidClientErr , ' pidClient error')
(f(9), a(50)) skip;
put edit(cPidClientFound, ' pidClient found')
(f(9), a(50)) skip;
put edit(cPidClientInto, ' pidClient select into')
(f(9), a(50)) skip;
end;
else do;
put ('no Fun ' || fun) skip;
end;
put edit(cCommit , ' commits')
(f(9), a(50)) skip;
put ('end qzCdPut noSql=', noSql) skip;
if ( 1 = 0) then do;
if ( yCDPUT3k.in.CDPUT3_traceLevel > 1 ) then
aux.isPutOn = '1'b ;
else
aux.isPutOn = '0'b ;
if isHeading_ok ( 'YCDPUT3 '
, in.CDPUT3_pid ) then
do;
select ( CDPUT3_processType ) ;
when ( '1' ) /* Top-Module */
do;
if processType_1() then ;
end;
when ( '2' ) /* Sub-Module */
do;
if processType_2() then ;
end;
when ( '3' ) /* Top-Module duration schreiben */
do;
if processType_3() then ;
end;
otherwise
do;
/* kann leer sein. */
end;
end; /* select */
end;
call Footing ( 'YCDPUT3' ) ; /* pgmName */
end;
end QZCDPUT;