Discussion :

[McNinja]

Bonjour à vous...

J'ai un soucis dans la gestion de message dans un sous fichier.
Si un champ est vide dans l'écran, le programme cobol appel un CL pour envoyer un message d'anomalie:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
/******************************************
/*Envoi d'un message dans la pgmq du programme appelant
/******************************************
          IF         COND(&ACTION *EQ 'S') THEN(SNDPGMMSG +
                      MSGID(&MSGID) MSGF(&FICMSG) MSGDTA(&MSGDTA))

ACTION est valorisé à 'S'
MSGID contient le numéro de l'erreur
FICMSG contient le nom du fichier des erreurs
MSGDTA est vide

Une fois le message envoyé, le composant cobol écrit le sous fichier et le fichier, mais la zone ou devrait être écrite l'anomalie dans le sous fichier est vide.
voici mon sous fichier:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
A*****************************************************************     
A* sous fichier de message                                       *     
A*****************************************************************     
A          R MSGS01                    SFL                             
A                                      SFLMSGRCD(24)                   
A            MSGKEY                    SFLMSGKEY                       
A            PGM                       SFLPGMQ(10)                     
A*****************************************************************     
A* Format de contrôle du sous fichier de message                 *     
A*****************************************************************     
A          R MSGC01                    SFLCTL(MSGS01)                  
A                                      OVERLAY                         
A                                      SFLDSP                          
A                                      SFLDSPCTL                       
A                                      SFLINZ                          
A  50                                  SFLEND                          
A                                      SFLSIZ(0010)                    
A                                      SFLPAG(0001)                    
A            PGM                       SFLPGMQ(10)

J'ai alimenté le nom de la file d'attente de message PGM OF MSGS01-O et PGM OF MSGC01-O avec le nom de mon programme

Et je ne comprends pas la raison. Je suis passé en debug dans le CL et dans le programme, je ne vois rien qui cloche.
Quelqu'un aurait-il une idée?

merci

[Mercure]

Colle ici stp les instructions cobol d'affichage du S-F.

Tu ferais bien d'utiliser l'API QMHSNDPM qui remplacerait avantageusement ton CL qui renvoie le message à ton cobol. De plus, le paramétrage de cette API serait totalement intégré à ton programme cobol sans besoin de faire appel à un programme CL ou cobol.

[McNinja]

En gros, voila ce que j'ai dans mon programme cobol

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
* Message "Merci de renseigner le numéro client"    
  MOVE "C2CMSGF" TO W-FICMSG         
  MOVE "XAC402" TO PGM OF MSGS01-O PGM OF MSGC01-O.     
  MOVE "ACM0001" TO W-MSGID                         
  MOVE "S" TO W-ACTION.                           
  CALL "YTRTMSGQCL" USING W-ACTION                
                        W-FICMSG                
                        W-MSGID                 
                        W-MSGDTA.               

* Affichage du sous fichier de message                     
   WRITE FD-ECRAN FROM F-MSGC01 FORMAT IS "MSGC01"       
                                          INDIC W-INDIC.       

* Affichage de l'écran                                          
     WRITE FD-ECRAN FROM F-CTLACSI2 FORMAT IS "CTLACSI2"         
                                      INDIC W-INDIC.             
        
                                                
  INITIALIZE W-MSGID W-MSGDTA.

Edit/fusion :
As tu un exemple d'utilisation et des paramétrage de QMHSNDPM pour mon cas ?

[Mercure]

A priori, je ne vois rien qui cloche dans ton code.

Mais remplace le CL par le programme ci-dessous ou mieux, intègre-le à l'adaptant à ton programme Cobol à la place de l'appel du CL.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
      **********************************************************
      * Compiler comme suit :  (Opt 14 PDM)
      *
      *     CRTCBLPGM PGM(MaBib/SNDPGMMSG)
      *               SRCFILE(MaBib/QCBLLESRC)
      *               SRCMBR(SNDPGMMSG)
      *               DBGVIEW(*SOURCE)
      *
      **********************************************************

       PROCESS NOMONOPRC NOSTDTRUNC APOST.
       IDENTIFICATION DIVISION.
       PROGRAM-ID.  SNDPGMMSG.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SOURCE-COMPUTER. IBM-ISERIES.
       OBJECT-COMPUTER. IBM-ISERIES.
       DATA DIVISION.

       Working-Storage Section.

       01  QMHSNDPM-API.
           05  MESSAGE-ID         PIC X(07).
           05  QUALIFIED-MSGF-LIB.
               10  QUALIFIED-MSGF PIC X(10).
               10  QUALIFIED-LIB  PIC X(10).
           05  MSGDTA             PIC X(256).
           05  LENGTH-MSGDTA      PIC 9(09) BINARY.
           05  MESSAGE-TYPE       PIC X(10).
           05  CALL-STACK-ENTRY   PIC X(10).
           05  CALL-STACK-COUNT   PIC S9(09) BINARY.
           05  MESSAGE-KEY        PIC X(4) VALUE SPACES.
           05  ERROR-STUFF.
               10 BYTES-PROVIDED  PIC S9(09)  BINARY.
               10 BYTES-AVAILABLE PIC S9(09)  BINARY.
               10 EXCEPTION-ID    PIC X(07)   VALUE SPACES.
               10 RESERVED        PIC X(01)   VALUE SPACE.
               10 EXCEPTION-DATA  PIC X(100)  VALUE SPACES.

       Procedure Division.
       Start-Proc.

      * Initialisations
           Move 'CPF9897' To Message-ID.
           Move 'QCPFMSG' To Qualified-Msgf.
           Move '*LIBL'   To Qualified-Lib.
           Move 'Voici mon message'  To MsgDta.
           Move Length Of MsgDta To Length-MsgDta.
           Move '*DIAG'   To Message-Type.

     * **********************************************************************************
     * Ce que nous dit la doc IBM sur l'API QMHSNDPM :
     * http://publib.boulder.ibm.com/infocenter/iseries/v6r1m0/topic/apis/QMHSNDPM.htm

     * Call-Stack-Entry = '*' --> The current call stack entry
     * (that is, the one in which the program or procedure is 
     * using this API is running).
           Move '*'       To Call-Stack-Entry.

     * A number identifying the location in the call stack of the 
     * call stack entry to whose message queue the message is to be sent. 
     * The number is relative to the call stack entry identified by the 
     * Call stack entry parameter. It indicates how many calls up the 
     * call stack the target entry is from the one identified by the Call 
     * stack entry parameter. Valid values follow:
     *   0 --> Send the messages to the message queue of the entry specified 
     *         by the Call stack entry parameter.
     *   1 --> Send the messages to the message queue of the call stack entry 
     *         one earlier on the stack than the one identified by the Call 
     *         stack entry parameter.
     *   n --> Send the messages to the queue of the nth call stack entry earlier
     *         in the stack from the one identified by the Call stack entry parameter.

     *  You can use any positive number that does not exceed the actual number of 
     *  call stack entries in the call stack. Do not include the external message
     * queue in your count.
           Move 2         To Call-Stack-Count.  
  
           Move Spaces    To Message-Key.
           Move Length Of Error-Stuff  To Bytes-Provided.

      * Envoi du message au programme appelant
            Call 'QMHSNDPM' Using  MESSAGE-ID
                                   QUALIFIED-MSGF-LIB
                                   MSGDTA
                                   LENGTH-MSGDTA
                                   MESSAGE-TYPE
                                   CALL-STACK-ENTRY
                                   CALL-STACK-COUNT
                                   MESSAGE-KEY
                                   ERROR-STUFF.

            If Bytes-Available > 0
               display 'Ya un os : ' exception-id, exception-data
            End-If

            Stop Run.

Si tu remplaces ton CL par ce programme, laisse les paramètres tels quels.
Ce programme envoie le message à la PGMQ du programme appelant.
Pourquoi 2 au lieu de 1 ? Parce que les programmes ILE créent une procédure d'entrée (PEP: Program Entry Procedure) qui se place au dessus du programme dans le stack.

Si en revanche tu l'intègres à ton programme, change juste le

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Move 2         To Call-Stack-Count.

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Move 0         To Call-Stack-Count.

En effet, tu enverrais alors le message à la PGMQ du programme courant et non plus à la PGMQ du programme appelant.

En utilisant l'API,

• tu programmes de façon moderne,
• tu découvres ou te lances enfin dans les APIs,
• tu évites la création d'un autre programme,
• la programmation devient plus intéressante,
• et d'autres points positifs que j'oublie sans doute.

[McNinja]

Merci bcp pour ton aide mais j'ai tjs le meme problème, rien ne s'affiche:

Définition de mon écran

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
* Ecran pour lancement du traitement                   
     SELECT ECRAN ASSIGN WORKSTATION-XAC402FM-SI       
     ORGANIZATION IS TRANSACTION                       
     ACCESS       IS DYNAMIC                           
     RELATIVE KEY IS SFL-KEY                           
     CONTROL-AREA IS W-CTRL-ECR                        
     FILE STATUS  IS XAC402FM-STA.

l'appel à QMHSNDPM est dans un paragraphe dans mon programme principal (XAC402)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
...
...
JBA                                                              
JBA   * Alimentation nom de la file d'attente de message         
JBA        MOVE "XAC402" TO PGM OF MSGS01-O PGM OF MSGC01-O.     
...
...
        TRTM-QMHSNDPM SECTION.                                
        DEBUT.                                                
 JBA   *                                                      
               MOVE "ACM0001" TO MESSAGE-ID                   
               MOVE "C2CMSGF" TO QUALIFIED-MSGF               
               MOVE "*LIBL"   TO QUALIFIED-LIB                
               MOVE "Voici mon message"  TO MSGDTA            
               MOVE LENGTH OF MSGDTA TO LENGTH-MSGDTA         
               MOVE "*DIAG"   TO MESSAGE-TYPE                 
               MOVE "*"       TO CALL-STACK-ENTRY             
       *       Envoi du message au programme en cours         
               MOVE 0         TO CALL-STACK-COUNT             
               MOVE SPACES    TO MESSAGE-KEY                  
               MOVE LENGTH OF ERROR-STUFF TO BYTES-PROVIDED   
               Call "QMHSNDPM" USING  MESSAGE-ID              
                                      QUALIFIED-MSGF-LIB      
                                      MSGDTA                  
                                      LENGTH-MSGDTA           
                                      MESSAGE-TYPE   
                                     CALL-STACK-ENTRY                 
                                     CALL-STACK-COUNT                 
                                     MESSAGE-KEY                      
                                     ERROR-STUFF                      
              If Bytes-Available > 0                                  
                   display "Ya un os : " exception-id, exception-data 
              End-If

ensuite dans mon code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
JBA   * Affichage du sous fichier de message                                  
JBA        WRITE FD-ECRAN FROM F-MSGC01 FORMAT IS "MSGC01"                    
JBA                                    INDIC W-INDIC.                         
                                                                              
      * Affichage de l'écran                                         *        
           WRITE FD-ECRAN FROM F-CTLACSI2 FORMAT IS "CTLACSI2"                
                                            INDIC W-INDIC.                 
      * Lecture de l'écran                                   *    
           READ ECRAN INTO CTLACSI2-I INDIC W-INDIC

et voici une partie de mon écran: (le début puis la fin)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
A*%%EC                                                            
A                                      DSPSIZ(24 80 *DS3)         
A                                      REF(*LIBL/REPERTOIRE)      
A                                      CHGINPDFT                  
A                                      PRINT                      
A                                      INDARA                     
A                                      CA03(03 'Abandon')         
A          R CTLACSI2                                             
A N91                                  CF05(05 'VALIDER')         
A                                      CF12(12 'PRECEDENT')       
A N92                                  CF20(20 'CONFIRMER')       
A            CTLCLI         7A  H                                 
.....
.....
A            PIEDSAB1      79A  O 22  1DSPATR(HI)                  
A                                      DSPATR(UL)                  
A                                 23  1'F3=Fin'                    
A                                      COLOR(BLU)                  
A                                 23 15'F5=Valider'                
A  91                                  DSPATR(ND)                  
A                                      COLOR(BLU)                  
A                                 23 31'F12=Précédent'             
A                                      COLOR(BLU)                  
A                                 23 65'F20=Confirmer'             
A  92                                  DSPATR(ND)                  
A                                      COLOR(BLU)                  
A***************************************************************** 
A* sous fichier de message                                       * 
A***************************************************************** 
A          R MSGS01                    SFL                          
A                                      SFLMSGRCD(24)                
A            MSGKEY                    SFLMSGKEY                    
A            PGM                       SFLPGMQ(10)                  
A*****************************************************************  
A* Format de contrôle du sous fichier de message                 *  
A*****************************************************************  
A          R MSGC01                    SFLCTL(MSGS01)               
A                                      OVERLAY                      
A                                      SFLDSP                       
A                                      SFLDSPCTL                    
A                                      SFLINZ                       
A  50                                  SFLEND                       
A                                      SFLSIZ(0010)                 
A                                      SFLPAG(0001)                 
A            PGM                       SFLPGMQ(10)

Comment QMHSNDPM sait il ou écrire le message (cad dans mon sous fichier de message) ?
Je suis passé en debug et Bytes-Available est = 0 ... Mais rien n'y fait, le message ne s'affiche pas!

[Mercure]

Voici un programme que j'ai vite fait sur le gaz et repris d'après ton programme.

Le programme ci-dessous envoie bien les messages dans le SF des messages.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
       PROCESS NOMONOPRC NOSTDTRUNC APOST.
       IDENTIFICATION DIVISION.
       PROGRAM-ID. XAC402.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
         SOURCE-COMPUTER. IBM-AS400.
         OBJECT-COMPUTER. IBM-AS400.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
      * Ecran pour lancement du traitement
           SELECT ECRAN ASSIGN WORKSTATION-XAC402FM-SI
           ORGANIZATION IS TRANSACTION
           ACCESS       IS DYNAMIC       
           RELATIVE KEY IS SFL-KEY       
           CONTROL-AREA IS Ecran-Ctl-Area
           FILE STATUS  IS XAC402FM-STA.

       DATA DIVISION.
       FILE SECTION.
       FD  ECRAN.
       01  FD-ECRAN.
           COPY DDS-ALL-FORMATS OF XAC402FM.

       Working-Storage Section.

       01  SFL-KEY   PIC 99 VALUE ZERO.   
                                   
       01  Ecran-Ctl-Area.                
           05 FUNCTION-KEY PIC X(2).      
           05 PGM-DEVICE-NAME PIC X(10).  
                                   
       01  WS-Indicators.
           05  IN03                   PIC 1 INDIC 03.
            88 End-Program         VALUE B'1'.
            88 NOT-End-Program     VALUE B'0'.
           05  IN50                   PIC 1 INDIC 50.
            88 Sflend              VALUE B'1'.
            88 NOT-Sflend          VALUE B'1'.

       01  XAC402FM-STA     PIC XX.

       01  QMHSNDPM-API.
           05  MESSAGE-ID         PIC X(07).
           05  QUALIFIED-MSGF-LIB.
               10  QUALIFIED-MSGF PIC X(10).
               10  QUALIFIED-LIB  PIC X(10).
           05  MSGDTA             PIC X(256).
           05  LENGTH-MSGDTA      PIC 9(09) BINARY.
           05  MESSAGE-TYPE       PIC X(10).
           05  CALL-STACK-ENTRY   PIC X(10).
           05  CALL-STACK-COUNT   PIC S9(09) BINARY.
           05  MESSAGE-KEY        PIC X(4) VALUE SPACES.
           05  ERROR-STUFF.
               10 BYTES-PROVIDED  PIC S9(09)  BINARY.
               10 BYTES-AVAILABLE PIC S9(09)  BINARY.
               10 EXCEPTION-ID    PIC X(07)   VALUE SPACES.
               10 RESERVED        PIC X(01)   VALUE SPACE.
               10 EXCEPTION-DATA  PIC X(100)  VALUE SPACES.

       Procedure Division.
       DEBUT.
           OPEN I-O ECRAN.
           SET NOT-End-Program To True.

       * Set MESSAGE SUBFILE parameters for QMHSNDPM API
           Move 'CPF9897' To Message-ID.
           Move 'QCPFMSG' To Qualified-Msgf.
           Move '*LIBL'   To Qualified-Lib.
           Move 'Voici mon message'  To MsgDta.
           Move Length Of MsgDta To Length-MsgDta.
           Move '*DIAG'   To Message-Type.
           Move '*'       To Call-Stack-Entry.
           Move 0         To Call-Stack-Count.
           Move Spaces    To Message-Key.
           Move Length Of Error-Stuff  To Bytes-Provided.

      * Set Sflend On message subfile
           Set Sflend To True.

      * Send error message to the MESSAGE SUBFILE
      * using QMHSNDPM API 
            Call 'QMHSNDPM' Using  MESSAGE-ID
                                   QUALIFIED-MSGF-LIB
                                   MSGDTA
                                   LENGTH-MSGDTA
                                   MESSAGE-TYPE
                                   CALL-STACK-ENTRY
                                   CALL-STACK-COUNT
                                   MESSAGE-KEY
                                   ERROR-STUFF.

            If Bytes-Available > 0
               display 'Ya un os : ' exception-id, exception-data
            End-If

            Perform AFFICHE-ECR Until End-Program.

            Close ECRAN.
            EXIT PROGRAM.
            Stop Run.

       AFFICHE-ECR.
      * Display main screen                                          
           WRITE FD-ECRAN FORMAT IS 'FMT1'
                           INDIC WS-Indicators.

      * Display message subfile 
           MOVE 'XAC402' TO PGMQ OF MSGC01-O.
           WRITE FD-ECRAN FORMAT IS 'MSGC01'
                           INDIC WS-Indicators.

      * Read Screen                                    
           READ ECRAN INDIC WS-Indicators.

Je pense que l'instruction de ton programme

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

MOVE "XAC402" TO PGM OF MSGS01-O PGM OF MSGC01-O.

a déc... en n'alimentant pas correctement PGM OF MSGC01-O mais je n'en suis pas sûr.