 /****************************************************************/
 /* Versi original abans d'implementar la stored procedure      */
 /* Data: 25-Jun-2015                                            */
 /****************************************************************/
 /* Modificaci de Tags de Sender Mail Messages - JBG 10/12/2013 */
 /* 20150727 JOS Canviar busqueda de primer blanc per busqueda darrer */
 /*              digit significatiu. D'aquesta manera, es menjar     */
 /*              qualsevol valor que vingui com a to, cc i bcc        */
 dcl 1 area_xml,
     2 tagxml       char(043)
  init('<es.generali.arq.sender.model.EmailMessage>'),
     2 tagxml_s     char(043)
  init('<es.generali.arq.sender.model.PhoneMessage>'),
     2 tagmail,
       3 tagidMsg      char(011) init('<idMessage>'),
       3 tagaplic      char(013) init('<application>'),
       3 tagfrom       char(006) init('<from>'),
       3 tagcia        char(009) init('<company>'),
       3 tagStr        char(008) init('<string>'),
       3 tagto         char(008) init('<toList>'),
       3 tagcont       char(013) init('<textContent>'),
       3 tagmsgtype    char(013) init('<messageType>'), /* mail */
       3 tagpath       char(014) init('<templatePath>'), /* mail */
       3 taguser       char(006) init('<user>'),
       3 tagcerti      char(013) init('<certificate>'),
       3 tagcc         char(008) init('<ccList>'),       /* nou */
       3 tagbcc        char(009) init('<bccList>'),      /* nou */
       3 tagreply      char(013) init('<replyToList>'),  /* nou */
       3 tagsubject    char(009) init('<subject>'),  /* nou */
       3 tagtemplat    char(014) init('<templateName>'),  /* nou */
       3 tagtmpbind    char(018) init('<templateBindings>'), /* nou */
       3 tagbexPr      char(015) init('<bexProperties>'),
       3 tagrefId      char(013) init('<referenceId>'), /* dexpeb */
       3 tagalias      char(009) init('<aliasId>'), /* attbex */
       3 taglabel      char(007) init('<label>'), /* White label */
       3 tagtitle      char(015) init('<documentTitle>'), /* wdesdc */
       3 tagtype       char(014) init('<documentType>'), /* tipdo  */
       3 tagdossier    char(013) init('<dossierType>'), /* tipbex */
       3 tagfolder     char(012) init('<folderType>'), /* idcarp */
       3 tagLink       char(024) init('<downloadPdfLinkEnabled>'),
       3 tagentry      char(007) init('<entry>'),
       3 tagattach     char(012) init('<attachList>'),
       3 tagattachLab  char(013) init('<attachLabel>'),
       3 tagBex        char(046) init(''),
       3 taghost       char(047) init(''),
       3 tagid         char(004) init('<id>'),
       3 tagfilenam    char(010) init('<fileName>'),
       3 tagfilpath    char(010) init('<filePath>'),
       3 tagDocuId     char(012) init('<documentId>'),
       3 tagmimeT      char(010) init('<mimeType>'),
       3 tagymthtm     char(009) init('<mthtmId>'),
       3 tagusrjob     char(006) init('<user>'),        /*VSIRVSIRAdd*/
       3 tagtrn        char(017) init('<hostTransaction>'),
       3 tagjcl        char(011) init('<hostChain>'),
       3 tagpas        char(010) init('<hostStep>'),
       3 tagpgm        char(013) init('<hostProgram>'),
       3 taguser_s     char(014) init('<externalUser>'),
       3 tagto_s       char(014) init('<receiverList>'),
       3 tagfrom_s     char(024) init('<acknowledgementAddress>'),
       3 tagidiom      char(022) init('<acknowledgementIdiom>'),
       3 tagcont_s     char(009) init('<content>'),
       3 tagcodif      char(017) init('<contentEncoding>'),
       3 tagmtid       char(006) init('<mtId>'),
       3 tagsched      char(010) init('<schedule>'),
       3 tagidMsg_fi   char(012) init('</idMessage>'),
       3 tagaplic_fi   char(014) init('</application>'),
       3 tagfrom_fi    char(007) init('</from>'),
       3 tagcia_fi     char(010) init('</company>'),
       3 tagStr_fi     char(009) init('</string>'),
       3 tagto_fi      char(009) init('</toList>'),
       3 tagcont_fi    char(014) init('</textContent>'),
       3 tagmsgtype_fi char(014) init('</messageType>'),
       3 tagpath_fi    char(015) init('</templatePath>'), /* mail */
       3 taguser_fi    char(007) init('</user>'),
       3 tagcerti_fi   char(014) init('</certificate>'),
       3 tagcc_fi      char(009) init('</ccList>'),       /* nou */
       3 tagbcc_fi     char(010) init('</bccList>'),      /* nou */
       3 tagreply_fi   char(014) init('</replyToList>'),  /* nou */
       3 tagsubject_fi char(010) init('</subject>'),  /* nou */
       3 tagtemplat_fi char(015) init('</templateName>'),  /* nou */
       3 tagtmpbind_fi char(019) init('</templateBindings>'), /* nou */
       3 tagbexPr_fi   char(016) init('</bexProperties>'),
       3 tagrefId_fi   char(014) init('</referenceId>'),
       3 tagalias_fi   char(010) init('</aliasId>'),
       3 taglabel_fi   char(008) init('</label>'), /* White label */
       3 tagtitle_fi   char(016) init('</documentTitle>'),
       3 tagtype_fi    char(015) init('</documentType>'), /* tipdoc */
       3 tagdossier_fi char(014) init('</dossierType>'), /* tipbex */
       3 tagfolder_fi  char(013) init('</folderType>'), /* idcarp */
       3 tagLink_fi    char(025) init('</downloadPdfLinkEnabled>'),
       3 tagentry_fi   char(008) init('</entry>'),
       3 tagBex_fi     char(047) init(''),
       3 tagHost_fi    char(048) init(''),
       3 tagattach_fi  char(013) init('</attachList>'),
       3 tagattachLab_fi char(014) init('</attachLabel>'),
       3 tagid_fi      char(005) init('</id>'),
       3 tagfilenam_fi char(011) init('</fileName>'),
       3 tagfilpath_fi char(011) init('</filePath>'),
       3 tagDocuId_fi  char(013) init('</documentId>'),
       3 tagmimeT_fi   char(011) init('</mimeType>'),
       3 tagymthtm_fi  char(010) init('</mthtmId>'),
       3 tagusrjob_fi  char(007) init('</user>'),       /*VSIRUI1-Add*/
       3 tagtrn_fi     char(018) init('</hostTransaction>'),
       3 tagjcl_fi     char(012) init('</hostChain>'),
       3 tagpas_fi     char(011) init('</hostStep>'),
       3 tagpgm_fi     char(014) init('</hostProgram>'),
       3 taguser_s_fi  char(015) init('</externalUser>'),
       3 tagto_s_fi    char(015) init('</receiverList>'),
       3 tagfrom_s_fi  char(025) init('</acknowledgementAddress>'),
       3 tagidiom_fi   char(023) init('</acknowledgementIdiom>'),
       3 tagcont_s_fi  char(010) init('</content>'),
       3 tagcodif_fi   char(018) init('</contentEncoding>'),
       3 tagmtid_fi    char(007) init('</mtId>'),
       3 tagsched_fi   char(011) init('</schedule>'),
       3 tagmodatt_fi  char(048) init(''),
     2 tagxml_fi       char(044)
 init('</es.generali.arq.sender.model.EmailMessage>'),
     2 tagxml_fi_s     char(044)
 init('</es.generali.arq.sender.model.PhoneMessage>');

 /* Inicialitzem valor al tag del attach de Bex   */
 tagbex =
 '<es.generali.arq.sender.model.email.BEXAttach>';

 /* Inicialitzem valor al tag del attach de host   */
 taghost =
 '<es.generali.arq.sender.model.email.HOSTAttach>';

 /* Inicialitzem valor al tag del attach de Bex   */
 tagbex_fi =
 '</es.generali.arq.sender.model.email.BEXAttach>';

 /* Inicialitzem valor al tag del attach de host   */
 taghost_fi =
 '</es.generali.arq.sender.model.email.HOSTAttach>';

 dcl 1 constants_ARQR12 unaligned,
       2 inici_constants_stsra5 char(3) init('*K*'),
       2 @activat          bit(1)  init('1'b),
       2 @no_activat       bit(1)  init('0'b),
       2 max_dsname        bin fixed(31) init(44),
       2 primera           bin fixed(31) init(1),
       2 primer            char(1) init('P'),
       2 ultim             char(1) init('U'),
       2 no                char(1) init('N'),
       2 si                char(1) init('S'),
       2 from_def   char(40) var init('mainframe@generali.es'),
       2 fi_constants_ARQR12   char(3) init('*K*');

 dcl 1 parametres_ARQR12 unaligned based(addr(kr5511.fill01)),
       2 @invocacio         bin fixed(31),
       2 @email_tractat     char(1),
       2 reste              char(24);

 /* unificaci registres ik5060 i ik5511, els camps que no son
   comuns el cridant (SMS) ha de crear una estructura del tipus sms
   e informar a la variable AWKSMS */
 dcl 1 sms UNALIGNED BASED(KR5511.AWKSMS),
       2 YIDIO2         CHAR(2),
       2 YDATHO         CHAR(12),
       2 YMSGER         CHAR(100),
       2 YCODIF         CHAR(7);

 dcl ioarea_xml char(32767) var init('');

 dcl text_error  char(80) init('');

 dcl unet_char     char(4)  based(addr(kr5511.aeunet));
 dcl usuari_conect char(30) var init('');
 dcl Num_aux    char(14)  init('');
 dcl mfrom      char(80)  init('');
 dcl Msg_type   char(4)  varying init('mail');
 dcl Idiom_def  char(2)  init('ES');
 dcl Certi_def  char(5)  var init('false');
 dcl from_defk  char(18) init('arqmet@generali.es');
 dcl ymesg_pic  pic'zzzzzzzzzzzzz9';
 dcl ymesg_char char(14) var init('');
 /* sms */
 dcl Codif_def  char(4)  init('text');
 dcl taula_num  char(11) value('0123456789+');

 /* ------------------------------ */
 /*  C = Cajamar Seguros Generales */
 /*  M = Cajamar Vida              */
 /*  K = Generali                  */
 /*  V = A.I.E                     */
 dcl taula_ycli  char(4)  value('CMKV');


 /* ----------------------------------------------, jbg-sms */

 dcl ptr_area   ptr;
 dcl area       char(80) based(ptr_area);
 dcl larea      bin fixed(31) init(0);
 larea = length(area);

 dcl ptr_areattach ptr;
 dcl areattach char(80) based(ptr_areattach);
 dcl lareattach bin fixed(31) init(0);
 lareattach = length(areattach);

 %IF @PARMVSI_YENTR  = 'B'
 %THEN %DO;
 /* JBG --------------------------------- */
 DCL KWORD               CHAR(6) VAR      INIT('');
 DCL entre_parentesi     BIN FIXED(31)    INIT(0);
 DCL parentesi_ini       BIN FIXED(31)    INIT(0);
 DCL parentesi_fin       BIN FIXED(31)    INIT(0);
 DCL KMEMBRE             BIT(1) INIT('0'B);
 DCL ZSEQ                BIT(1) INIT('0'B);
 DCL NOM_DSN_FICHENT     CHAR(44) VAR;
 DCL LONG_NOM_DSN        BIN FIXED(31)    INIT(0);
 /* JBG --------------------------------- */
 %END;
 DCL zcia    CHAR(1) INIT('');
 DCL zprog   CHAR(8) INIT('');
 DCL zpas    CHAR(8) var INIT('');
 DCL zjcl    CHAR(8) var INIT('');
 DCL ztrn    CHAR(8) var INIT('');
 DCL zusuari CHAR(8) var INIT('');
 DCL from_2044 char(256) var INIT('');
 DCL to_2044   char(256) var INIT('');
 DCL msg_error char(100) var INIT('');

 dcl cr         char(001)     init('0D'x);
 dcl coma       char(001)     init(',');
 dcl primer     char(1) init('p');
 dcl ultim      char(1) init('u');
 dcl ito        bin fixed(31) init(0);
 dcl ix40       bin fixed(31) init(0);
 dcl max_long   bin fixed(31) init(0);
 dcl itopic     Pic'ZZZ9' init(0);
 dcl ito_char   char(4) var init('');
 max_long = larea - 8;
 dcl max_long_attach bin fixed(31) init(0);
 max_long_attach = lareattach;

 /* proces */
 /* Pel Process d'unificaci suposem que es crida via mail
    en cas contrari es modifiquen les variables per tractar msg */
 if (KR5511.YEMTDS = 'S') Then
   do;
     Msg_type = 'sms';
   end;
 /* ---------------------------------------------------------------- */
 /* - Recuperem els valors Jcl, pas, programa, transacci i usuari - */
 /* ---------------------------------------------------------------- */
 %IF @PARMVSI_YENTR  = 'B'  /* JBG...*/
 %THEN %DO;
    @INCLUDE HISTS049;
    CALL STSR15(STSR11,KPAR1_STSR11,FDATE);
    zjcl   = KPAR1_STSR11.NOMJOB;
    zpas   = KPAR1_STSR11.NOMPAS;
    zprog  = KPAR1_STSR11.NOMPGM;
    ztrn   = '';
    zcia   = KPAR1_STSR11.DADESDB2;
    zusuari= KPAR1_STSR11.JOBUSER;
    kr3803.MQPRTY = '0';   /*EFB prioritat baixa per batch*/
 %END;
 %IF @PARMVSI_YENTR  = 'C'  /* JBG...*/
 %THEN %DO;
    EXEC CICS ASSIGN INVOKINGPROG(zprog);
    ztrn   = EIBTRNID;
    zpas = '';
    zjcl = '';
    zcia   = CLIENTWA;
    zusuari=OPERTWA;
    If (time() > '000000000') & (time() < '070000000')
       THEN kr3803.MQPRTY = '0'; /*EFB prioritat baixa per batch*/
       ELSE kr3803.MQPRTY = '9'; /*EFB prioritat alta per cics mati*/
 %END;

 /* En el cas de SMS el client es reb com a parmetre */
 if (KR5511.YEMTDS = 'E') | (KR5511.YEMTDS = ' ') Then
   do;   /* s un email*/
     KR5511.YCLI = zcia;
  /* PUT DATA(KR5511); */
   end;

 DCL V_YMTHTM    CHAR(50)   BASED(KR5511.AMTHTM);              /* VMB */
 DCL V_ATTLAB    CHAR(50)   BASED(KR5511.AATTLB);

 select(mqacci);
  when('cmit','back') call xstsr65;
   other do;
    /* ------------------------------------------------- */
    /* Insert del nou id_message amb YESTAD = 'RECEIVED' */
    CALL XINSERT_YMESG;

    if (KR5511.YEMTDS = 'E') | (KR5511.YEMTDS = ' ') Then /* email */
     do;
       call xtagmail;
       call xtagmessage;
       call xtagextra_dest;
       call xtagtemplate;
       call xtagattachs;
       call xtaginsbex;
       call xcertificat;
       ioarea_xml = ioarea_xml || tagxml_fi;
       call xwrite_mqseries;
    end;
    else if (KR5511.YEMTDS = 'S') then /* SMS */
     do;
       call xtagsms;
       call xtagmessage;
       call xtagtemplate;
       call xtaginsbex;
       call xtagfinal;
       call xwrite_mqseries;
     end;
     else
      do;
          call xerror_parametre('yemtds',01);
          %IF @PARMVSI_YENTR  = 'B'
          %THEN %DO;
          put skip list('ARQR12E-yemtds: '||KR5511.YEMTDS);
          %end;
      end;

    /* Update del nou id_message amb YESTAD = 'ENQUEUED' */
    CALL XUPDATE_YMESG;

   end;
 End;

 %IF @PARMVSI_YENTR  = 'C'
 %THEN %DO;
 EXEC CICS RETURN;
 %end;

 /* ------------------------------------------------------ */
 xtagmail:proc reorder;

 ioarea_xml = tagxml;

 /* Insertem Id_message */
 ioarea_xml = ioarea_xml || tagidMsg ||trim(ymesg_char,' ') ||
              tagidMsg_fi;

 /* Posem Application Arq_Sender */
 ioarea_xml = ioarea_xml || tagaplic || 'arq_sender' || tagaplic_fi;

 /* Tractament de la companyia , ex: Cajamar Seguros Generales */
 ioarea_xml = ioarea_xml || tagcia ||trim(kr5511.YCLI,' ')|| tagcia_fi;

 /* Tractament d'usuari
 ptr_area = kr5511.aeunet;
 If unet_char = low(4) then do;
    if area = ''
    then call xerror_parametre('aeunet',01);
    else do;

       call xtroba_blanc(primer);
       usuari_conect = substr(area,1,ix40);
       call verifica_user_cia;
       ioarea_xml = ioarea_xml || taguser || substr(area,1,ix40) ||
                    taguser_fi;

    end;
 End;
 Else call xerror_parametre('aeunet',01);  */

 /* Tractament d'usuari */
 ioarea_xml = ioarea_xml || taguser || zusuari ||
              taguser_fi;
 /* Tractament del from */
 ioarea_xml = ioarea_xml || tagfrom;

 ptr_area = kr5511.aemfro;
 if area = ''
 then do;
     ioarea_xml = ioarea_xml || from_def;
     mfrom = from_def;
 End;
 else do;
    call xtroba_blanc(primer);
    if ix40 > max_long
    then call xerror_parametre('aemfro',01);

    if index(area,'@') = 0
    then ioarea_xml = ioarea_xml || from_defk || tagfrom_fi;

    else ioarea_xml = ioarea_xml || substr(area,1,ix40) || tagfrom_fi;

    from_2044 = substr(area,1,ix40);

    mfrom = substr(area,1,ix40);

 end;

 /* Comencem a tractar el to: */
 ptr_area = kr5511.atemto;

 ioarea_xml = ioarea_xml || tagto;
 if kr5511.nemto = 0
 then call xerror_parametre('nemto',01);
 to_2044 = to_2044||'TO:';
 do ito = 1 to kr5511.nemto;
    call xtroba_blanc(ultim); /*20150727 JOS*/

    if ix40 > max_long
    then call xerror_parametre('nemto',02);
    else do;
         If length(substr(area,1,ix40)) = 0 then do;
            If ito = 1 then call xerror_parametre('nemto',03);
         end;
         Else
           do;
           ioarea_xml = ioarea_xml || tagStr || substr(area,1,ix40) ||
                        tagStr_fi;

           to_2044 = to_2044||substr(area,1,ix40)||';';
           End;
    ptr_area = pointeradd(ptr_area,larea);
    end;
 End;
 ioarea_xml = ioarea_xml || tagto_fi;

 End Xtagmail;

 /* --------------------------------------------------------------- */
 /* Afegim els tags per a les plantilles  ------------------------- */
 /* --------------------------------------------------------------- */
 xtagtemplate: Proc Reorder;

    dcl varvalue  char(500) var;

    dcl 1 taula_pl(100) based(kr5511.aempla),
          2 nomvar     char(80) var,
          2 valvar     char(500) var;

  /*Do ito=1 to kr5511.nemvar;
       put skip list('taula_pl(ito).nomvar :'||taula_pl(ito).nomvar);
       put skip list('taula_pl(ito).valvar :'||taula_pl(ito).valvar);
    End;*/

    dcl path_aux  char(3) var init('');
    if kr5511.nemvar = 0
    then do;

       path_aux = kr5511.pathpl;
       path_aux = trim(kr5511.pathpl,' ');
       do ito = 1 to kr5511.nemvar;

          if ito = 1 then do; /* la primera s el nom plantilla */
             ioarea_xml = ioarea_xml ||tagtemplat||
                          taula_pl(ito).nomvar||tagtemplat_fi;

             If length(path_aux) = 3 then
                call xerror_parametre('pathpl',02);
             Else If kr5511.pathpl = '' then
                     call xerror_parametre('pathpl',01);
                  Else ioarea_xml = ioarea_xml ||tagpath ||
                             Trim(path_aux,' ')|| tagpath_fi;

             ioarea_xml = ioarea_xml ||tagtmpbind;

          end;
          Else ioarea_xml = ioarea_xml ||tagentry || tagstr ||
                            taula_pl(ito).nomvar  || tagstr_fi;

          If ito = 1 then do; /* la primera s el nom plantilla */
             ioarea_xml = ioarea_xml ||
                 tagstr ||xsubsti(taula_pl(ito).valvar)||
                 tagstr_fi ||tagentry_fi;
          End;
       end;
       ioarea_xml = ioarea_xml ||tagtmpbind_fi;
    End;

 end xtagtemplate;
 /* --------------------------------------------------------------- */
 /* Destinataris Extres, CC, BCC i ReplyTo ------------------------ */
 /* --------------------------------------------------------------- */
 Xtagextra_dest: Proc Reorder;

    ptr_area = kr5511.atemcc;
    if kr5511.nemcc = 0
    then do;
       to_2044 = to_2044||'CC:';
       ioarea_xml = ioarea_xml || tagcc;
       do ito = 1 to kr5511.nemcc;
          call xtroba_blanc(ultim); /*20150727 JOS*/
          if ix40 > max_long
             then call xerror_parametre('atemcc',01);
          else do;
             ioarea_xml = ioarea_xml ||tagStr|| substr(area,1,ix40) ||
                          tagStr_fi;

             to_2044 = to_2044||substr(area,1,ix40)||';';
          end;
          ptr_area = pointeradd(ptr_area,larea);
       end;
       ioarea_xml = ioarea_xml || Tagcc_fi;
    end;

    ptr_area = kr5511.atembc;
    if kr5511.nembcc = 0
    then do;
       to_2044 = to_2044||'BCC:';
       ioarea_xml = ioarea_xml || tagbcc;
       do ito = 1 to kr5511.nembcc;
          call xtroba_blanc(ultim); /*20150727 JOS*/
          if ix40 > max_long then call xerror_parametre('atembc',01);
          else do;
             ioarea_xml = ioarea_xml ||tagStr|| substr(area,1,ix40) ||
                          tagStr_fi;

             to_2044 = to_2044||substr(area,1,ix40)||';';
          end;
          ptr_area = pointeradd(ptr_area,larea);
       end;
       ioarea_xml = ioarea_xml || Tagbcc_fi;
    end;

    ptr_area = kr5511.aemrto;
    if area = ''
    then do;
       ioarea_xml = ioarea_xml || Tagreply;
       call xtroba_blanc(primer);
       if ix40 > max_long then call xerror_parametre('aemrto',01);
       else ioarea_xml = ioarea_xml || tagStr ||
                         substr(area,1,ix40)  ||tagStr_fi;

       ioarea_xml = ioarea_xml ||tagreply_fi;
    end;
    /* Else call xerror_parametre('aemrto',02); Jbg 04/12/2013 */


 /* --------------------------------------------------------------- */
 /* Subject del missatge ------------------------------------------ */
 /* --------------------------------------------------------------- */
 ioarea_xml = ioarea_xml || tagsubject;
 if kr5511.wemsub = '' then call xerror_parametre('wemsub',01);
 else do;
    ptr_area = addr(kr5511.wemsub);
    call xtroba_blanc(ultim);

    ioarea_xml = ioarea_xml ||substr(area,1,ix40)|| tagsubject_fi;
 end;

 End Xtagextra_dest;

 %page;

 xtagmessage:proc reorder;

 dcl karea   char(32767) var init('');

 ptr_area = kr5511.atemlt;
 if (kr5511.yemtds = 'E') | (kr5511.yemtds = ' ') then
   do;
     ioarea_xml = ioarea_xml || tagcont;

     do ito = 1 to kr5511.nemltx;
        ioarea_xml = ioarea_xml || xsubsti(area);
        ptr_area = pointeradd(ptr_area,larea);
     end;

     ioarea_xml = ioarea_xml || tagcont_fi;
   End;
  Else
   do;
     ioarea_xml = ioarea_xml || tagcont_s;

     /*EFB es va detectar a BRARQR10 que l'ultim carcter quan s blanc
       es junta amb el primer carcter de la 2 linea. Per evitar-ho i
       no generar problemes amb el antic funcionament, quan aix pasi
       l'aplicatiu posa el caracte 41'x'. rtrim no l'elimina pero aquesta
       rutina la substitueix per un blanc, ja que en el movil "41X"
       apareix com el carcter ? */
     do ito = 1 to kr5511.nemltx;
        ioarea_xml = ioarea_xml ||
                 translate(rtrim(xsubsti(area)),'40'X,'41'X);
        ptr_area = pointeradd(ptr_area,larea);
     end;
 /* VSIRUI1 - No possar el messageType (quan s SMS)
 ioarea_xml = ioarea_xml || tagmsgtype || Msg_type || tagmsgtype_fi;
  */

     ioarea_xml = ioarea_xml || tagcont_s_fi;
   End;

 /* ------------------------------------------------------- */
 /* -------- Informaci de tran, jcl, pgm, pgma i user ---- */
 /* -------------------------------------------------------

 ioarea_xml = ioarea_xml || tagjcl || trim(zjcl,' ')  || tagjcl_fi;
 ioarea_xml = ioarea_xml || tagtrn || trim(ztrn,' ')  || tagtrn_fi;
 ioarea_xml = ioarea_xml || tagpas || trim(zpas,' ')  || tagpas_fi;
 ioarea_xml = ioarea_xml || tagpgm || trim(zprog,' ') || tagpgm_fi;

 ioarea_xml = ioarea_xml || tagcerti || Certi_def || tagcerti_fi;

 ioarea_xml = ioarea_xml || tagmsgtype || Msg_type || tagmsgtype_fi; */

 end xtagmessage;

 /* ------9-------------------------------------------------------- */
 /* Afegim els tags per a els fitxers anexats --------------------- */
 /* --------------------------------------------------------------- */
 xtagattachs: Proc Reorder;

 dcl mimepdf    char(15) value('application/pdf');
 dcl mimetext   char(10) value('text/plain');
 dcl contb      bin fixed(31) init(0);
 dcl kk         bin fixed(31) init(0);

 dcl tipus     char(1) init('');

 dcl 1 workarea,
     2 codi      char(1),
     2 farcidor1 char(1),
     2 resta     char(78); /* 44 var pdsname || * || file name var */

 ptr_areattach = kr5511.atemda;

 If kr5511.nemdsa = 0
 then do;
 ioarea_xml = ioarea_xml || tagattach;

   do ito = 1 to kr5511.nemdsa;

      itopic   = ito;
      kk = 0;
      do contb = 4 TO 1 BY -1 While(SUBSTR(itopic,contb,1) = '');
         kk = kk + 1;
      End;
      ito_char = Substr(itopic,contb+1,KK);

      call xtroba_blanc_attach(primer);
      if ix40 > max_long_attach
      then call xerror_parametre('atemda',01);
      else do;

        string(workarea) = substr(areattach,1,ix40);
        tipus = workarea.codi;
        /*
        substr(resta,index(resta,'*')+1,ix40-2-index(resta,'*'))||
        tagfilenam_fi; */

        If tipus = 'I' then do;
           ioarea_xml=ioarea_xml||taghost;

           ioarea_xml=ioarea_xml||tagfilenam||
           substr(resta,index(resta,'*')+1,ix40-2-index(resta,'*'))||
                      tagfilenam_fi;

           ioarea_xml=ioarea_xml||tagmimeT||mimetext||tagmimeT_fi;

           ioarea_xml=ioarea_xml||tagfilpath||
                   substr(resta,1,index(resta,'*')-1)||tagfilpath_fi;

           ioarea_xml=ioarea_xml||taghost_fi;
        End;
        Else do;
             ioarea_xml=ioarea_xml||tagbex;

             ioarea_xml=ioarea_xml||tagfilenam||
             substr(resta,index(resta,'*')+1,ix40-2-index(resta,'*'))||
                    tagfilenam_fi;

             ioarea_xml=ioarea_xml||tagmimeT||mimepdf||tagmimeT_fi;

             ioarea_xml=ioarea_xml||tagDocuId||
                     substr(resta,1,index(resta,'*')-1)||tagDocuId_fi;

             ioarea_xml=ioarea_xml||tagbex_fi;
        End;

        %IF @PARMVSI_YENTR  = 'B'
        %THEN %DO;
        If tipus = 'E' then do;
           NOM_DSN_FICHENT=
           substr(resta,1,index(resta,'*')-1);
           PUT SKIP LIST('                            ');
           PUT SKIP LIST('I000-DSNAME '||NOM_DSN_FICHENT);
           KMEMBRE = '0'B;
           KWORD = '';
           IF INDEX(NOM_DSN_FICHENT,'(') > 0 THEN DO;
              parentesi_ini = INDEX(NOM_DSN_FICHENT,'(');
              parentesi_fin = INDEX(NOM_DSN_FICHENT,')');
              entre_parentesi = parentesi_fin - parentesi_ini - 1;
              KMEMBRE = '1'B;
              /* POT SER (0)  (+1) */
              IF entre_parentesi = 2 | entre_parentesi = 1
                 THEN KWORD='GDG';
              ELSE KWORD = 'MEMBRE';

              IF KWORD = 'GDG' then do;
                 PES_ANEX_CHAR ='PDS';
                 PUT SKIP LIST('I001-S UN '||KWORD||
                               ', NO COMPROVAREM EL '||
                               'TAMANY, NOMS QUE EXISTEIXI');
                 PES_ANEX_CHAR = '0';
              End;
              Else do;
                 ZSEQ = '1'b;
                 Call verifica_fitxer;
                 PES_ANEXES = PES_ANEXES + TOTAL_PES;
              end;
           END;
           ELSE DO;
             ZSEQ = '1'B;
             Call verifica_fitxer;
             PES_ANEXES = PES_ANEXES + TOTAL_PES;
           END;
        End;
    /*  PUT SKIP LIST('            ');
        If tipus = 'E' then PES_ANEX_CHAR = '0';
        ioarea_xml = ioarea_xml||tagsize||PES_ANEX_CHAR||tagsize_fi;
         END %;
         ELSE DO %;
        ioarea_xml = ioarea_xml||tagsize||'1'||tagsize_fi; */
        %END;

      end;
      ptr_areattach = pointeradd(ptr_areattach,lareattach);
   end;
   ioarea_xml = ioarea_xml||tagattach_fi;

 %IF @PARMVSI_YENTR  = 'B'
 %THEN %DO;
 IF ZSEQ THEN DO;
    IF PES_ANEXES > 9999999 THEN DO;
       PES_ANEX_PIC = PES_ANEXES;
       PUT SKIP LIST('                           ');
       PUT SKIP LIST('E003-TOTAL BYTES '||
                     'ANEXATS SUPERA 10.000.000 Bytes :'||
                      PES_ANEX_PIC);
       PUT SKIP LIST('                           ');
       CALL PLIRETC(12);
       KR5511.YRETX2 = 12;
       GOTO FI;
    END;
    ELSE DO;
       PES_ANEX_PIC = PES_ANEXES;
       PUT SKIP LIST('                           ');
       IF KWORD = 'GDG' THEN DO;
          PUT SKIP LIST('I003-TOTAL BYTES ANEXATS SENSE COMPTAR '||
                        'ELS GDG :'|| PES_ANEX_PIC);
       END;
       ELSE DO;
          PUT SKIP LIST('I003-TOTAL BYTES ANEXATS :'||
                         PES_ANEX_PIC);
       END;
       PUT SKIP LIST('                           ');
    END;
 END;
 %END;
 End;

 IF KR5511.ZATTLB = 'L'
 THEN ioarea_xml=ioarea_xml||tagattachlab||TRIM(V_ATTLAB,' ')||
                 tagattachlab_FI;

 End xtagattachs;
 /* --------------------------------------------------------------- */
 /* Afegim els tags per a inserci de documents a la Bex ---------- */
 /* --------------------------------------------------------------- */
 xtaginsbex: Proc Reorder;

     If kr5511.zbex = 'S' then do;

        ioarea_xml=ioarea_xml||tagbexpr;

        If kr5511.dexpeb = '' then
           ioarea_xml=ioarea_xml||tagrefId||trim(kr5511.dexpeb,' ')||
                                  tagrefId_fi;
     /* Else call xerror_parametre('dexpeb',01); */

        If kr5511.attbex = '' then
           ioarea_xml=ioarea_xml||tagalias||trim(kr5511.attbex,' ')||
                                  tagalias_fi;

        If kr5511.wlabel = '' then
           ioarea_xml=ioarea_xml||taglabel||trim(kr5511.wlabel,' ')||
                                  taglabel_fi;

        If kr5511.wdesdc = '' then
           ioarea_xml=ioarea_xml||tagtitle||trim(kr5511.wdesdc,' ')||
                                  tagtitle_fi;
     /* Else call xerror_parametre('wdesdc',01); */

        If kr5511.tipdo = '' then
           ioarea_xml=ioarea_xml||tagtype||trim(kr5511.tipdo,' ')||
                                  tagtype_fi;
        Else call xerror_parametre('tipdo',01);

        If kr5511.tipbex = 0 then
           ioarea_xml=ioarea_xml||tagdossier||trim(kr5511.tipbex,' ')||
                                  tagdossier_fi;
        Else call xerror_parametre('tipbex',01);

        If kr5511.idcarp = 0 then
           ioarea_xml=ioarea_xml||tagfolder||kr5511.idcarp||
                                  tagfolder_fi;
        Else call xerror_parametre('idcarp',01);


        If kr5511.zlink = 'S' then
           ioarea_xml=ioarea_xml||tagLink||'true'||tagLink_fi;
        Else ioarea_xml=ioarea_xml||tagLink||'false'||tagLink_fi;

        ioarea_xml=ioarea_xml||tagbexpr_fi;
     End;

     /* Afegim el tag  <mthtmid> si cont dades
     If V_YMTHTM = '' then ioarea_xml=ioarea_xml||
                            tagymthtm||trim(V_YMTHTM,' ')||tagymthtm_fi;
     */

     IF KR5511.YVRGEM > 'F1A' & trim(V_YMTHTM,' ',' ') =''
     then ioarea_xml=ioarea_xml||
          tagymthtm||trim(V_YMTHTM,' ')||tagymthtm_fi;

 End xtaginsbex;

 /* -----------------------------------------------------*/
 /* ------------ Tractament de from, to i cia ---------- */
 /* -----------------------------------------------------*/
 xtagsms:proc reorder;

 ioarea_xml = tagxml_s;

 /* Insertem Id_message */
 ioarea_xml = ioarea_xml || tagidMsg ||trim(ymesg_char,' ') ||
              tagidMsg_fi;

 /* Posem Application Arq_Sender VSIRUI1 - Afegit*/
 ioarea_xml = ioarea_xml || tagaplic || 'arq_sender' || tagaplic_fi;

 /* Tractament de la companyia , ex: Generali  */
 If kr5511.YCLI = '' then call xerror_parametre('ycli',01);
 Else
   do;
      If verify(kr5511.YCLI,taula_ycli) > 0
      then call xerror_parametre('ycli',02);

      ioarea_xml = ioarea_xml || tagcia ||
      trim(kr5511.YCLI,' ')|| tagcia_fi;
   end;

 /* Tractament d'usuari VSIRUI1 - afegit*/
 ioarea_xml = ioarea_xml || tagusrjob || zusuari ||
                tagusrjob_fi;

 /* VSIRUI1 - Mogut de xtagfinal */
 ioarea_xml = ioarea_xml || tagtrn || trim(ztrn,' ')  || tagtrn_fi;
 ioarea_xml = ioarea_xml || tagjcl || trim(zjcl,' ')  || tagjcl_fi;
 ioarea_xml = ioarea_xml || tagpas || trim(zpas,' ')  || tagpas_fi;
 ioarea_xml = ioarea_xml || tagpgm || trim(zprog,' ') || tagpgm_fi;

 /* Informem del camp usuari de conexi */
 ptr_area = kr5511.aeunet;
 If unet_char = low(4) then do;
    if area = ''
    then call xerror_parametre('aeunet',22);
    else do;

       call xtroba_blanc(primer);
       ioarea_xml = ioarea_xml || taguser_s || substr(area,1,ix40) ||
                    taguser_s_fi;

       usuari_conect = substr(area,1,ix40);
    end;
 End;
 Else call xerror_parametre('aeunet',22);
 Call verifica_user_cia;


 /* Comencem a tractar el to: */
 ioarea_xml = ioarea_xml || tagto_s || tagStr;
 ptr_area = kr5511.atemto;

 if kr5511.nemto = 0
 then call xerror_parametre('nemto',01);

 do ito = 1 to kr5511.nemto;

    call xtroba_blanc(primer);

    If verify(substr(area,1,ix40),taula_num) > 0
    then do;
       to_2044 = substr(area,1,ix40);
       call xerror_parametre('nemto',03);
    end;
    /*
    If ix40 < 9    Com a mnim 9 nmeros
    then call xerror_parametre('nemto',04);*/

    if ix40 > max_long
    then call xerror_parametre('nemto',02);
    else do;
       to_2044 = to_2044||substr(area,1,ix40)||';';
       ioarea_xml = ioarea_xml || substr(area,1,ix40) || tagStr_fi;
    end;
    if ito < kr5511.nemto
    then ioarea_xml = ioarea_xml || tagStr;

    ptr_area = pointeradd(ptr_area,larea);

 end;
 ioarea_xml = ioarea_xml || tagto_s_fi;


 /* Tractament del from */ /* VSIRUI1 - Truere el tag string */
 ioarea_xml = ioarea_xml || tagfrom_s;

 ptr_area = kr5511.aemfro;
 if area = ''
 then do;
    ioarea_xml = ioarea_xml || from_def || tagfrom_s_fi;
    from_2044 = from_def;
 End;
 else do;

    call xtroba_blanc(primer);
    if ix40 > max_long
    then call xerror_parametre('aemfro',01);

    /* if index(area,'@') = 0
    then call xerror_parametre('aemfro',02); */

    if index(area,'@') = 0
    then do;
         ioarea_xml = ioarea_xml || from_defk || tagfrom_s_fi;
         from_2044 = from_defk;
    end;
    else do;
         ioarea_xml = ioarea_xml || substr(area,1,ix40) || tagfrom_s_fi;
         from_2044 = substr(area,1,ix40);
    end;

 end;

 /* Idioma de l'acusament de rebut. VSIRUI1 - Mogut de xtagfinal */
 If sms.YIDIO2 = '' then
    ioarea_xml = ioarea_xml || tagidiom || Idiom_def || tagidiom_fi;
 Else do;
    If sms.YIDIO2 = 'ES' & sms.YIDIO2 = 'CA' &
       sms.YIDIO2 = 'EN' & sms.YIDIO2 = 'FR' &
       sms.YIDIO2 = 'DE' & sms.YIDIO2 = 'IT' &
       sms.YIDIO2 = 'NL' & sms.YIDIO2 = 'PT'
    then call xerror_parametre('yidio2',01);

    ioarea_xml = ioarea_xml || tagidiom ||sms.YIDIO2||tagidiom_fi;
 End;

 end xtagsms;

 /* ------------------------------------------------------- */
 /* ----------------  El ltims Tags de l'XML ------------- */
 /* ------------------------------------------------------- */
 xtagfinal:proc reorder;

 /* VSIRUI1 - Moure tagjcl, tagtrn, tagpas, tagpgm a xtagsms */

 /* Informem de la codificaci, o text o unicode */
 If sms.YCODIF = '' then
    ioarea_xml = ioarea_xml || tagcodif || Codif_def || tagcodif_fi;
 Else do;
    sms.YCODIF = lowercase(sms.YCODIF);
    If (sms.YCODIF = 'text   ' & sms.YCODIF = 'unicode')
       then call xerror_parametre('ycodif',01);

    ioarea_xml = ioarea_xml || tagcodif || Trim(sms.YCODIF,' ') ||
                 tagcodif_fi;
 End;


 /* VSIRUI1 - Moure taguser (usuariConexio) a xtagsms */

 /* Informem de l'identificador de missatge */
 If kr5511.YMTID = '' then
    ioarea_xml = ioarea_xml || tagmtid || tagmtid_fi;
 Else do;
    ioarea_xml = ioarea_xml || tagmtid || Trim(kr5511.ymtid,' ') ||
                 tagmtid_fi;
 End;


 /* Idioma de l'acusament de rebut. VSIRUI1 - Moure a tagsms */

 /* tag Scheduled */
 If sms.YDATHO = '' then
    ioarea_xml = ioarea_xml || tagsched || tagsched_fi;
 Else do;

    If verify(sms.YDATHO,taula_num) > 0
       then call xerror_parametre('ydatho',01);

       ioarea_xml=ioarea_xml||tagsched||sms.YDATHO||tagsched_fi;
 End;


 Call xcertificat;

 ioarea_xml = ioarea_xml || tagxml_fi_s;

 end xtagfinal;


 xcertificat:proc reorder;

 If kr5511.YEMCON = '' then
  ioarea_xml = ioarea_xml || tagcerti || Certi_def || tagcerti_fi;
 Else do;
    If kr5511.YEMCON = 'S' then Certi_def = 'true';
    Else If kr5511.YEMCON = 'N' then Certi_def = 'false';
         Else call xerror_parametre('yemcon',01);

  ioarea_xml = ioarea_xml || tagcerti || Certi_def || tagcerti_fi;
 End;

 end xcertificat;


 /* --------------------------------------------------------------- */
 xtroba_blanc_attach:proc(tipus) reorder;

 dcl tipus char(1);
 dcl karea   char(32767) var init('');
 karea = areattach;
 areattach = substr(xsubsti(karea),1,80);
 if tipus = primer
 then do;
    ix40 = index(areattach,' ');
    if ix40 = 0
    then ix40 = lareattach;
    else ix40 = ix40 - 1;
    end;
 else do;
    do ix40 = lareattach to 1 by -1;
       if substr(areattach,ix40,1) = ' '
       then leave;
       end;
    if ix40 = 0
    then ix40 = lareattach;
    end;

 end xtroba_blanc_attach;

 xtroba_blanc:proc(tipus) reorder;

 dcl tipus char(1);
 dcl karea   char(32767) var init('');
 karea = area;
 area = substr(xsubsti(karea),1,80);
 if tipus = primer
 then do;
    ix40 = index(area,' ');
    if ix40 = 0
    then ix40 = larea;
    else ix40 = ix40 - 1;
    end;
 else do;
    do ix40 = larea to 1 by -1;
       if substr(area,ix40,1) = ' '
       then leave;
       end;
    if ix40 = 0
    then ix40 = larea;
    end;

 end xtroba_blanc;



 /*xsubsti:proc(area) returns(char(32767) varying) recursive;

 dcl area  char(32767) varying;
 dcl a bin fixed (31) init(index(area,'&'));
 dcl b bin fixed (31) init(index(area,'<'));
 dcl c bin fixed (31) init(index(area,'>'));
 dcl d bin fixed (31) init(index(area,'"'));
 dcl karea bin fixed(31) init(length(area));  * a mes enlla de area *
 dcl farcidor char(10) varying init('');
 if a = 0 then karea = a;
 if b = 0 then karea = min(karea,b);
 if c = 0 then karea = min(karea,c);
 if d = 0 then karea = min(karea,d);
 select;
    when(a=karea) farcidor='&amp;';
    when(b=karea) farcidor='&lt;';
    when(c=karea) farcidor='&gt;';
    when(d=karea) farcidor='&quot;';
    other return(area);
    end;
 if karea = length(area)
 then return(substr(area,1,karea-1) || farcidor);
 else if karea = 1
      then return(farcidor || xsubsti(substr(area,2)));
      else return(substr(area,1,karea-1) || farcidor ||
                 xsubsti(substr(area,karea+1)));
 end xsubsti; */

 xsubsti:proc(area) returns(char(32767) varying);

 dcl area  char(32767) varying;
 dcl 1 areac_aux based(addr(area)),
     2 long bin fixed(15),
     2 areac (32767) char(1);
 dcl areas  char(32767) varying init('');;
 dcl len bin fixed(31) init(length(area));
 dcl i bin fixed(31) init(0);
 do while (i<len);
    i = i+1;
    if areac(i)='&' Then areas=areas||'&amp;';
    else if areac(i)='<' Then areas=areas||'&lt;';
         else if areac(i)='>' Then areas=areas||'&gt;';
              else if areac(i)='"' Then areas=areas||'&quot;';
                   else  areas=areas||areac(i);
    End /*while*/;
 Return(areas);
 end xsubsti;

 /* ------------------------------------------------------------- */
 /* - Procediment per canviar carcters en Strings ms llargs  -- */
 /* ------------------------------------------------------------- */
 xsubsti_nou:proc(harea) returns(char(32767) varying);

 dcl harea  char(32767) varying;

 dcl h      bin fixed(31) init(0);
 dcl am     char(5)     init('&amp;');
 dcl lt     char(4)     init('&lt;');
 dcl gt     char(4)     init('&gt;');

 If index(harea,'<') > 0 | index(harea,'>') > 0 |
    index(harea,'&') > 0 then do;
    do h = 1 to 32767;
       If substr(harea,h,1) = '<' then do;
          harea = substr(harea,1,h-1) ||lt||substr(harea,h+1);
       End;
       Else If substr(harea,h,1) = '>' then do;
               harea = substr(harea,1,h-1) ||gt||substr(harea,h+1);
            End;
            Else If substr(harea,h,1) = '&' then do;
                    harea = substr(harea,1,h-1) ||am||substr(harea,h+1);
                 End;

       /* Per sortir */
       If index(substr(harea,h+1),'>') = 0 &
          index(substr(harea,h+1),'<') = 0 &
          index(substr(harea,h+1),'&') = 0 then do;
          h = 32767;
       End;
    End;
    Return(harea);
 End;
 Else return(harea);

 end xsubsti_nou;


 /* --------------------- */
 verifica_user_cia: proc;

    dcl sw_trobat    char(1) init('n');
    dcl cont_tau     bin fixed(31) init(0);

    dcl taula_k_cont bin fixed(31) init(6);
    dcl taula_v_cont bin fixed(31) init(10);
    dcl taula_c_cont bin fixed(31) init(1);
    dcl taula_m_cont bin fixed(31) init(1);

    dcl taula_k(6)  char(30) var;
    dcl taula_v(10) char(30) var;
    dcl taula_c(1)  char(30) var;
    dcl taula_m(1)  char(30) var;

    taula_k(*) = '';
    taula_v(*) = '';
    taula_c(*) = '';
    taula_m(*) = '';

    /* Usuaris de Generali */
    taula_k(1)= 'canalcliente@generali';
    taula_k(2)= 'c.rovira@generali';
    taula_k(3)= 'cos@generali'; /* genric */
    taula_k(4)= 'gta@generali'; /* genric */
    taula_k(5)= 'markactivo@generali'; /* Red comercial */
    taula_k(6)= 'anulpoliza@generali';

    /* Usuaris de A.I.E    */
    taula_v(1)= 'generali@generali';
    taula_v(2)= 'cat@generali';
    taula_v(3)= 'particulares@generali';
    taula_v(4)= 'autos@generali';
    taula_v(5)= 'empresas@generali';
    taula_v(6)= 'salud@generali';
    taula_v(7)= 'cos@generali'; /* genric */
    taula_v(8)= 'profesionales@generali';
    taula_v(9)= 'personales@generali';
    taula_v(10)= 'vida@generali';

    /* Usuaris de Cajamar Vida */
    taula_m(1)= 'cmv@generali'; /* genric */

    /* Usuaris de Cajamar Seguros Generales */
    taula_c(1)= 'csg@generali'; /* genric */
    /* ------------------------------ */

    Select(kr5511.YCLI);
       When('K') do;
           Do cont_tau = 1 to taula_k_cont;
              If usuari_conect = taula_k(cont_tau) then do;
                 sw_trobat = 's';
              End;
           End;
       end;
       When('V') do;
           Do cont_tau = 1 to taula_v_cont;
              If usuari_conect = taula_v(cont_tau) then do;
                 sw_trobat = 's';
              End;
           End;
       end;
       When('M') do;
           Do cont_tau = 1 to taula_m_cont;
              If usuari_conect = taula_m(cont_tau) then do;
                 sw_trobat = 's';
              End;
           End;
       end;
       When('C') do;
           Do cont_tau = 1 to taula_c_cont;
              If usuari_conect = taula_c(cont_tau) then do;
                 sw_trobat = 's';
              End;
           End;
       end;
       Otherwise;
    End;
    If sw_trobat = 'n' then call xerror_parametre('aeunet',02);

 end verifica_user_cia;

 Rtrim:proc(instring) returns (char(32767) varying);

   /* Rtrim treu els blancs de la dreta */

   dcl (instring)  char(32767) var;
   dcl (outstring) char(32767) var;
   dcl (i,long) fixed bin(31);
   dcl prou  bit(1)  init('0'b);
   /* trim trailing blanks */
   long = length (instring);
   do i = long to 1 by -1 while (prou = '0'b);
      if substr (instring,i,1) = ' ' then prou = '1'b;
   end;
   outstring = substr(instring,1,i+1);

   Return(outstring);

 end Rtrim;


 /* ------------------------------------------------------------- */
 xwrite_mqseries:proc reorder;

 if @email_tractat = si
 then @invocacio = @invocacio + 1;
 else do;
    @invocacio = primera;
    @email_tractat = si;
    call xconexion;
    end;
 call xput;

 end xwrite_mqseries;

 /* ------------------------------------------------------------- */
 xconexion:proc reorder;

    kr3803.mqacci = 'CONN';
    kr3803.mqarea = 'ARQ';
    kr3803.mqapli = 'SENDER';
    kr3803.mqcola = 'IN';
 %IF @PARMVSI_YENTR  = 'C'
 %THEN %DO;
    if OPERTWA = 'VSIRUI1' & ENTORNTWA = '4'
    then kr3803.mqcola = 'ACURECIN';
 %END;
 %else %DO;
    if zusuari = 'VSIRUI1' & TIPUSDB2  = '4'
    then kr3803.mqcola = 'ACURECIN';
 %end;
    kr3803.mqmat  = 'INF';
    kr3803.mqretc = 0;
    kr3803.mqresp = 0;

 call xstsr65;

 end xconexion;

 %page;

 xput:proc reorder;

 kr3803.mqacci = 'PUT1';
 kr3803.mqdire = addr(ioarea_xml) + 2;
 kr3803.mqlonm = length(ioarea_xml);

 /* Si superem els 32000 bytes casquem per que la cua t aquest lmit */
 If length(ioarea_xml) > 32000 then call xerror_parametre('lenare',01);
 /* ----------------------------------------------------------------- */

 %IF @PARMVSI_YENTR  = 'B'
 %then %do;
 put skip list ('area='||substr(ioarea_xml,1,length(ioarea_xml)));
 %end;
 call xstsr65;
 if kr3803.mqretc = 0
 then do;
    kr3803.mqacci = 'BACK';
    call xstsr65;
    kr3803.mqretc = 12;
    %IF @PARMVSI_YENTR  = 'B'
    %then %do;
    call pliretc(12);/* +---------- tractament pel batch ----------+ */
    kr5511.yretx2 = 12;
    goto fi; /* +---------- tractament pel batch ----------+ */
    %end;
    %else %DO;
    EXEC CICS RETURN;/* +---------- TRACTAMENT PEL CICS -----------+ */
    %end;
    END;

 end xput;

 %page;

 xerror_parametre:proc(parametre,numero) reorder;

 dcl parametre char(06) varying;
 dcl numero    pic'99';
 dcl i         bin fixed(31);
 dcl num_aux   pic'99' init(0);

 dcl 1 valors_taula,
     2 camp01    char(06) init('aemfro'),
     2 codi01    pic '99' init(01),
     2 literal01 char(80) init('-longitud superada en campo "from"'),
     2 camp02    char(06) init('nemto'),
     2 codi02    pic '99' init(01),
     2 literal02 char(80) init('-numero de elementos "to" igual a "0"'),
     2 camp03    char(06) init('nemto'),
     2 codi03    pic '99' init(02),
     2 literal03 char(80) init('-longitud superada en campo "to"'),
     2 camp04    char(06) init('atemcc'),
     2 codi04    pic '99' init(01),
     2 literal04 char(80) init('-longitud superada en campo "cc"'),
     2 camp05    char(06) init('atembc'),
     2 codi05    pic '99' init(01),
     2 literal05 char(80) init('-longitud superada en campo "bcc"'),
     2 camp06    char(06) init('aemrto'),
     2 codi06    pic '99' init(01),
     2 literal06 char(80) init('-longitud superada en campo "replyto"'),
     2 camp07    char(06) init('wemsub'),
     2 codi07    pic '99' init(01),
     2 literal07 char(80) init('-no ha informado asunto en "wemsub"'),
     2 camp08    char(06) init('atemda'),
     2 codi08    pic '99' init(01),
     2 literal08 char(80) init('-longitud superada en campo attach"'),
     2 camp09    char(06) init('nemto'),
     2 codi09    pic '99' init(03),
     2 literal09 char(80) init(''),
     2 camp10    char(06) init('aeunet'),
     2 codi10    pic '99' init(02),
     2 literal10 char(80)
       init("-El camp aeunet no pertany a la companyia especificada"),
     2 camp11    char(06) init('aemrto'),
     2 codi11    pic '99' init(02),
     2 literal11 char(80) init('-manca informar el camp "replyto"'),
     2 camp12    char(06) init('lenare'),
     2 codi12    pic '99' init(01),
     2 literal12 char(80) init('-Superat el lmit de 32000 bytes'),
     2 camp13    char(06) init('pathpl'),
     2 codi13    pic '99' init(01),
     2 literal13 char(80)
       init('-El Path/unitat no pot venir a blancs.'),
     2 camp14    char(06) init('attbex'),
     2 codi14    pic '99' init(01),
     2 literal14 char(80)
       init('-Si Zbex val -S- ATTBEX ha de venir informat.'),
     2 camp15    char(06) init('tipbex'),
     2 codi15    pic '99' init(01),
     2 literal15 char(80)
       init('-Si Zbex val -S- TIPBEX ha de venir informat.'),
     2 camp16    char(06) init('wdesdc'),
     2 codi16    pic '99' init(01),
     2 literal16 char(80)
       init('-Si Zbex val -S- WDESDC ha de venir informat.'),
     2 camp17    char(06) init('pathpl'),
     2 codi17    pic '99' init(02),
     2 literal17 char(80)
       init('-El Path/unitat ha de ser de 3 carcters, EVI, ARQ...'),
     2 camp18    char(06) init('dexpeb'),
     2 codi18    pic '99' init(01),
     2 literal18 char(80)
       init('-Si Zbex val -S- DEXPEB ha de venir informat.'),
     2 camp19    char(06) init('tipdo'),
     2 codi19    pic '99' init(01),
     2 literal19 char(80)
       init('-Si Zbex val -S- TIPDO ha de venir informat.'),
     2 camp20    char(06) init('idcarp'),
     2 codi20    pic '99' init(01),
     2 literal20 char(80)
       init('-Si Zbex val -S- IDCARP ha de venir informat.'),
     2 camp21    char(06) init('yemtds'),
     2 codi21    pic '99' init(01),
     2 literal21 char(80)
       init('-El camp yemtds ha de ser E (email) o S (SMS).'),
     2 camp22    char(06) init('aeunet'),
     2 codi22    pic '99' init(22),
     2 literal22 char(80)
       init('-El camp aeunet ha de ser informat.'),
     2 camp23    char(06) init('nemto'),
     2 codi23    pic '99' init(03),
     2 literal23 char(80) init('-Telfon de dest ha de ser numric'),
     2 camp24    char(06) init('yemcon'),
     2 codi24    pic '99' init(01),
     2 literal24 char(80)
       init('-El valor del certificat ha de ser S o N'),
     2 camp25    char(06) init('yidio2'),
     2 codi25    pic '99' init(01),
     2 literal25 char(80)
       init('-El idioma noms pot ser ES, CA, EN, FR, DE, IT, NL o PT'),
     2 camp26    char(06) init('ydatho'),
     2 codi26    pic '99' init(01),
     2 literal26 char(80)
       init('-El camp ydatho ha de ser format numric i AAAAMMDDHHMM'),
     2 camp27    char(06) init('ycodif'),
     2 codi27    pic '99' init(01),
     2 literal27 char(80)
       init('-El camp ycodif nomes pot ser "text" o "unicode"'),
     2 camp28    char(06) init('ycli'),
     2 codi28    pic '99' init(01),
     2 literal28 char(80)
       init("-El camp ycli ha de venir informat juntament amb aeunet"),
     2 camp29    char(06) init('ycli'),
     2 codi29    pic '99' init(02),
     2 literal29 char(80)
       init("-El camp ycli no es correcte, ha de ser o K, C, M o V");

 num_aux = ito;
 literal09='-el camp '||num_aux||' del "to" o ve a blancs o '||
           's incorrecte: '||substr(area,1,ix40);

 literal09=substr(literal09,1,80);

 dcl 1 taula_errors(29) based(addr(valors_taula)),
     2 camp_error char(06),
     2 codi_error pic'99',
     2 lit_error  char(80);

 do i = 1 to 29
    while(parametre = camp_error(i) | numero = codi_error(I));
    end;
 If i <= 29 Then text_error = lit_error(i);
            else text_error = 'Error desconegut. Avisar a ARQ';

 kr3803.mqretc = 2;                                         /* cics  */
 kr3803.mqresp = i;                                         /* cics  */
 %IF @PARMVSI_YENTR  = 'B'
 %then %do;
 if i <= 29 Then
 put skip list('ARQR12E-' || camp_error(i) || lit_error(I));/* batch */
 else
  put skip list('ARQR12E-'||text_error||' '||parametre||' '||numero);
 call pliretc(12);                                          /* batch */
 kr5511.yretx2 = 12;
 CALL XUPDATE_YMESG_ERROR;
 goto fi;                                                   /* batch */
 %end;
 %else %DO;
 CALL XUPDATE_YMESG_ERROR;
 EXEC CICS RETURN;                                          /* CICS  */
 %end;

 end xerror_parametre;



 xstsr65:proc reorder;

 %IF @PARMVSI_YENTR  = 'B'
 %then %do;
 call stsr69(stsr65,kr3803);                                 /* batch */
 %end;
 %else %DO;
 EXEC CICS LINK PROGRAM('STSC65') COMMAREA(KR3803);          /* CICS  */
 %end;
 if kr3803.mqretc = 0
 then do;
    %IF @PARMVSI_YENTR  = 'B'
    %then %do;
    select(mqacci);
       WHEN('PUT1')
          put skip list('ARQR12-ERROR PUT1 MQSERIES='||kr3803.mqretc||
                        ' '    || kr3803.mqresp);
       WHEN('CMIT') do;
          put skip list('ARQR12-ERROR CMIT MQS='||mqretc||'-'||mqresp);
          call pliretc(12);
          kr5511.yretx2 = 12;
          goto fi;
          end;
       WHEN('BACK') do;
          put skip list('ARQR12-ERROR BACK MQS='||mqretc||'-'||mqresp);
          call pliretc(12);
          kr5511.yretx2 = 12;
          goto fi;
          end;
       WHEN('CONN') do;
          put skip list('ARQR12-ERROR CONN MQS='||mqretc||'-'||mqresp);
          call pliretc(12);
          kr5511.yretx2 = 12;
          goto fi;
          end;
       other do;
          end;
       end;
    %end;
    %else %DO;
    EXEC CICS RETURN;
    %end;
    END;
 else DO;
    %IF @PARMVSI_YENTR  = 'B'
    %THEN %DO;
    select(mqacci);
       WHEN('CONN') put skip list('ARQR12-CONEXION MQSeries '||mqento||
                                ' ESTABLECIDA-'||mqretc||'-'||mqresp);
       WHEN('CMIT') put skip list('ARQR12-SE HA EFECTUADO CMIT');
       WHEN('BACK') put skip list('ARQR12-SE HA EFECTUADO BACK');
       other;
       end;
    %end;
    end;

 end xstsr65;
