H DATEDIT(*YMD/) DFTNAME(TESTPSSR)                                                             
     F********** *PSSR によるエラー監視 ************************************                        
     FSHOHIN    IF   E           K DISK                                                             
     F                                     INFSR(*PSSR)                                             
     F**********************************************************************                        
     D KINGAKU         S              7S 0 INZ(8000)                                                
     D SURYO           S              4S 0 INZ(0)                                                   
     D TANKA           S              7S 0                                                          
                                                                                                    
     D CPFMSGLIB       S             20A   INZ('QCPFMSG   *LIBL     ')                              
     D PGMSTKCNT       S             10I 0 INZ(1)                                小数               
     D EXCP_LEN        S             10I 0 INZ(80)                               小数               
     D APIERR          DS                                                                           
     D  GETBYT                 1      4B 0 INZ(160)                                                 
     D  AVLBYT                 5      8B 0 INZ(0)                                                   
     D  MSG_ID                 9     15                                                             
     D  MSG_DTA               17    160                                                             
                                                                                                    
     D*( プログラム状況データ構造 )                                                                 
     D INFDSP         SDS                                                                           
     D                              512A                                                            
     D  CPFID                         7A   OVERLAY(INFDSP:40)                                       
     D  PGMID                        10A   OVERLAY(INFDSP:334)                                      
     D  EXCP_ID                       4A   OVERLAY(INFDSP:171)                                      
     D  EXCP_DATA                    80A   OVERLAY(INFDSP:91)                                       
                                                                                                    
     C*  単価 =  金額 / 数量   を計算 (  数量は 0 である )                                          
     C                   EVAL      TANKA = KINGAKU / SURYO                                          
     C                   SETON                                        LR                            
     C                   RETURN                                                                     
     C                   READ      SHOHIN                                                           
     C******************************************************                                        
     C     *PSSR         BEGSR                                                                      
     C******************************************************                                        
     C     CPFID         IFNE      *BLANKS                                      CPFID<>*BLK         
     C*----------------------------------------------------+                                        
     C                   CALL      'QMHSNDPM'                                                       
     C                   PARM                    CPFID                          |                   
     C                   PARM                    CPFMSGLIB                      |                   
     C                   PARM                    EXCP_DATA                      |                   
     C                   PARM                    EXCP_LEN                       |                   
     C                   PARM      '*COMP     '  MSGTYPE          10            |                   
     C                   PARM      '*PGMBDY   '  PGMQUE           10            |                   
     C                   PARM                    PGMSTKCNT                      |                   
     C                   PARM                    MSGKEY            4            |                   
     C                   PARM                    APIERR                                             
     C*----------------------------------------------------+                                        
     C                   END                                                                        
     C                   ENDSR     '*CANCL'