FEXLLMQLT  IF   E           K DISK 
    FEXDINUL0  IF   E           K DISK    USROPN EXTMBR(MBRNAM) 
    FQPRINT    O    F  132        PRINTER OFLIND(*INOF) FORMLEN(66) FORMOFL(64) 
     *------------------------------------------------------------------------- 
    D X               S              3  0 
    D Y               S              3  0 
    D Z               S              3  0 
    D SEG             S              3 
    D BMG             S             73 
    D DTM             S              8  0 
    D FROM            S             73 
    D REF01           S              2    DIM(4) CTDATA PERRCD(4) 
    D REFTX           S             20    DIM(4) CTDATA PERRCD(1) 
    D REFER           S             73 
    D MSG             S            118    DIM(99) 
    D MIT01           S             30 
    D MIT02           S             80 
    D USADAT          S               D   DATFMT(*USA) 
     *------------------------------------------------------------------------- 
     * accept message log# passed from CL pgm 
    C     *ENTRY        PLIST 
    C                   PARM                    MSGLOG           11 
    C                   MOVE      MSGLOG        MSGLOG#          11 0 

     * get member name, element/segment seperators, starting/ending rec# 
    C     MSGLOG#       CHAIN     @LLMQLT                            10 
    C                   MOVE      LMINDL        MBRNAM           10 


     * open specific file member for current doc & read starting rec 
    C                   OPEN      EXDINUL0 
    C     LMNWRS        CHAIN     @DINUL0                            20 

     * loop until ending unwrapped rec found 
    C                   DOW       NOT *IN20 
    C 
    C                   SELECT 
     * get header message 
    C                   WHEN      %SUBST(INNWDT:1:4) = 'BMG' + LMELDM 
    C                   EVAL      X = %SCAN(LMELDM:INNWDT:8) - 8 
    C                   IF        X < 1 
    C                   EVAL      X = %LEN(%TRIM(INNWDT)) - 8 
    C                   ENDIF 
    C                   EVAL      BMG = %SUBST(INNWDT:8:X) 
     * customer from info 
    C                   WHEN      %SUBST(INNWDT:1:6) = 'N1' + LMELDM + 'FR' 
    C                             + LMELDM 
    C                   EVAL      X = %SCAN(LMELDM:INNWDT:7) - 7 
    C                   IF        X < 1 
    C                   EVAL      X = %LEN(%TRIM(INNWDT)) - 7 
    C                   ENDIF 
    C                   EVAL      FROM = %SUBST(INNWDT:7:X) 
     * get reference info 
    C                   WHEN      %SUBST(INNWDT:1:4) = 'REF' + LMELDM 
    C                   EVAL      X = %LOOKUP(%SUBST(INNWDT:5:2):REF01) 
    C                   EVAL      Y = %SCAN(LMSGDM:INNWDT) - 8 
    C                   IF        X < 1 
    C                   EVAL      X = %LEN(%TRIM(INNWDT)) - 8 
    C                   ENDIF 
    C                   EVAL      REFER = REFTX(X) + %SUBST(INNWDT:8:Y) 
     * get message identification 
    C                   WHEN      %SUBST(INNWDT:1:4) = 'MIT' + LMELDM 
    C                             AND LMTPCD = '3MCAN' 
    C                   EVAL      X = %SCAN(LMELDM:INNWDT:5) - 1 
    C                   EVAL      MIT01 = %SUBST(INNWDT:5:X) 
    C                   EVAL      Y = %SCAN(LMSGDM:INNWDT:X+2) - 1 
    C                   EVAL      MIT02 = %SUBST(INNWDT:X+2:Y) 
     * get message text 
    C                   WHEN      %SUBST(INNWDT:1:4) = 'MSG' + LMELDM 
    C                   EVAL      X = %SCAN(LMSGDM:INNWDT) - 5 
    C                   IF        X < 1 
    C                   EVAL      X = %LEN(%TRIM(INNWDT)) - 8 
    C                   ENDIF 
    C                   ADD       1             Z 
    C                   EVAL      MSG(Z) = %SUBST(INNWDT:5:X) 
    C                   ENDSL 

     * get next record & check if last rec for current doc 
    C                   READ      @DINUL0                                20 
    C  N20INNWRC        COMP      LMNWRE                                 20 
    C                   ENDDO 

    C                   CLOSE     EXDINUL0 
     * print header 
    C                   EXCEPT    #HEADER 

    C     1             DO        Z             X 
     * print messages 
    C                   EXCEPT    #MESSAGE 
    C                   ENDDO 

     * close spoolfile & send as email 
    C                   EXCEPT    #FOOTER 
    C                   MOVE      *ON           *INLR 

     * SEND SPLF via email 
     
       <---- INSERT EMAIL CODE HERE ---->

    C                   RETURN 
     *------------------------------------------------------------------------- 
    OQPRINT    E            #HEADER           1 
    O                                              'FROM: ' 
    O                       FROM 
    O          E            #HEADER     2 
    O                                              'RE..: ' 
    O                       REFER 
    O          E            #HEADER     1  1 
    O                       BMG 
    O          E            #MESSAGE    1 
    O                       MSG(X) 
    O          E            #FOOTER     2 
    O                                              '*** END OF REPORT***' 
**    *------------------------------------------------------------------------- 
IVIKSIPO 
** 
Invoice Number 
Invoice Number 
Shipment Number 
Purchase Order