IBM Mainframe Forum

       IDENTIFICATION DIVISION.
       PROGRAM-ID. ISSAREG.
      *
      *
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT INSISSAG ASSIGN TO ISSAENTR FILE STATUS IS WS-STATUS1.
      *    SELECT ISSAOUT  ASSIGN TO ISSAOUT  FILE STATUS IS WS-STATUS2.
      *
      *
       DATA DIVISION.
      *
       FILE SECTION.
       FD INSISSAG
           RECORDING MODE IS F
           BLOCK CONTAINS 257 CHARACTERS.
       01 REG-INSISSAG PIC X(257).
      *
      *FD ISSAOUT
      *    RECORDING MODE IS F
      *    BLOCK CONTAINS 320 CHARACTERS.
      *01 REG-ISSAOUT PIC X(320).
      *
       WORKING-STORAGE SECTION.
      *
       01 WS-STATUS1               PIC X(02).
       01 WS-STATUS2               PIC X(02).
      *
       01 WS-TABLE.
          05 WS-HEADER.
             10 WS-ANALYST            PIC X(20).
             10 WS-PROJECT            PIC X(20).
             10 WS-REQUESTER          PIC X(20).
          05 WS-DETAIL.
             10 CBA-MCN-BASE          PIC X(06).
             10 CBA-MCN-SFX           PIC X(03).
             10 CBA-SLS-OFC-CD        PIC X(02).
             10 CBA-BILL-GRP-NUM      PIC X(03).
             10 CBA-BILL-CYC-DAY      PIC X(02).
             10 CBA-BILLING-NAME      PIC X(36).
             10 CBA-BILLING-ADDR-1    PIC X(36).
             10 CBA-BILLING-ADDRESS-2 PIC X(36).
             10 CBA-CITY-NM           PIC X(30).
             10 CBA-PO-OUT-OF-COUNTRY PIC X(36).
             10 CBA-ST-ABBR           PIC X(02).
             10 CBA-ZIP-CD            PIC X(09).
             10 CBA-BILLER-ID         PIC X(02).
             10 CBA-TYA               PIC X(02).
             10 FILLER                PIC X(16).
      *
       01 WS-MCN                      PIC X(06).
       01 WS-SO                       PIC X(02).
       01 WS-BG                       PIC X(03).
       01 WS-ALT                      PIC X(20).
       01 WS-PJT                      PIC X(20).
       01 WS-RQT                      PIC X(20).
      *
       01 ASTERISK                    PIC X(2).
      *
       PROCEDURE DIVISION.
      *
       0000-MAIN.
           PERFORM 1000-OPEN
           PERFORM 2000-UNSTRING
           PERFORM 3000-CLOSE
           STOP RUN.
      *
       1000-OPEN.
           OPEN INPUT  INSISSAG.
      *    OPEN OUTPUT ISSAOUT.
      *
       2000-UNSTRING.
      *    READ INSISSAG    INTO WS-DETAIL
           READ INSISSAG INTO WS-DETAIL

      *    UNSTRING
      *      REG-INSISSAG DELIMITED BY "*"
      *    INTO
      *           WS-ANALYST
      *           WS-PROJECT
      *           WS-REQUESTER
      *    END-UNSTRING

      *    MOVE WS-ANALYST TO WS-ALT
      *    MOVE WS-PROJECT TO WS-PJT
      *    MOVE WS-REQUESTER TO WS-RQT

           DISPLAY WS-DETAIL

           UNSTRING
                  WS-DETAIL DELIMITED BY '*'
      *           REG-INSISSAG DELIMITED BY "*"
           INTO
                  ASTERISK
                  CBA-MCN-BASE
                  CBA-MCN-SFX
                  CBA-SLS-OFC-CD
                  CBA-BILL-GRP-NUM
                  CBA-BILL-CYC-DAY
                  CBA-BILLING-NAME
                  CBA-BILLING-ADDR-1
                  CBA-BILLING-ADDRESS-2
                  CBA-CITY-NM
                  CBA-PO-OUT-OF-COUNTRY
                  CBA-ST-ABBR
                  CBA-ZIP-CD
                  CBA-BILLER-ID
                  CBA-TYA
           END-UNSTRING

      *    DISPLAY "ANALIST = " WS-ANALYST
      *    DISPLAY "PROJECT = " WS-PROJECT
      *    DISPLAY "REQUESTER = " WS-REQUESTER

      *    DISPLAY "MCN = "       WS-MCN
      *    DISPLAY "SO = "        WS-SO
      *    DISPLAY "BG = "        WS-BG

           DISPLAY "MCN = " CBA-MCN-BASE
           DISPLAY "SFX = " CBA-MCN-SFX
           DISPLAY "SO = " CBA-SLS-OFC-CD
           DISPLAY "BG = " CBA-BILL-GRP-NUM
           DISPLAY "CYC = " CBA-BILL-CYC-DAY
           DISPLAY "NAME = " CBA-BILLING-NAME
           DISPLAY "ADDR = " CBA-BILLING-ADDR-1
           DISPLAY "ADDR2 = " CBA-BILLING-ADDRESS-2
           DISPLAY "CITY = " CBA-CITY-NM
           DISPLAY "FRNG = " CBA-PO-OUT-OF-COUNTRY
           DISPLAY "ST = " CBA-ST-ABBR
           DISPLAY "ZIP = " CBA-ZIP-CD
           DISPLAY "BILLER ID = " CBA-BILLER-ID
           DISPLAY "TYA = " CBA-TYA.
      *
       3000-CLOSE.
           CLOSE INSISSAG.
      *    CLOSE ISSAOUT.


*J2F208**12*001*31*121156 CUST FO8*425 14TH STREET NW***ATLANTA**GA*30318*PL*XX;
*J2F208**12*002*31*121156 CUST FO8*2039 JOHN F KENNEDY BOULEVARD WEST***JERSEY CITY**NJ*7305*PL*XX;
*J2F208**12*003*31*121156 CUST FO8*300 GROVE ST***SAN FRANCISCO**CA*94102*PL*XX;
*J2F208**12*005*31*121156 CUST FO8*120 KING ST****MELBOURNE, 3000, AUSTRALIA***PL*XX;
*J2F208**12*006*31*121156 CUST FO8*MEDIACORP RADIO****SINGAPORE, 912899, SINGAPORE***PL*XX;
*J2F209**12*001*31*121156 CUST FO9*1730 W FULLERTON AVE***CHICAGO**IL*60614*PL*XX;
*J2F209**12*002*31*121156 CUST FO9*19 LANCASTER GATE****LONDON, W23LG, UNITED KINGDOM***PL*XX;
*J2F209**12*003*31*121156 CUST FO9*ATISALANI CADDESI NO: 135****ISTANBUL, 34180, TURKEY***PL*XX;
Odair Pitoli Junior;
121212;
*J2F208**12*001*31*121156 CUST FO8*425 14TH STREET NW***ATLANTA**GA*30318*PL*XX;
*J2F208**12*002*31*121156 CUST FO8*2039 JOHN F KENNEDY BOULEVARD WEST***JERSEY CITY**NJ*7305*PL*XX;
*J2F208**12*003*31*121156 CUST FO8*300 GROVE ST***SAN FRANCISCO**CA*94102*PL*XX;
*J2F208**12*005*31*121156 CUST FO8*120 KING ST****MELBOURNE, 3000, AUSTRALIA***PL*XX;
*J2F208**12*006*31*121156 CUST FO8*MEDIACORP RADIO****SINGAPORE, 912899, SINGAPORE***PL*XX;
*J2F209**12*001*31*121156 CUST FO9*1730 W FULLERTON AVE***CHICAGO**IL*60614*PL*XX;
*J2F209**12*002*31*121156 CUST FO9*19 LANCASTER GATE****LONDON, W23LG, UNITED KINGDOM***PL*XX;
*J2F209**12*003*31*121156 CUST FO9*ATISALANI CADDESI NO: 135****ISTANBUL, 34180, TURKEY***PL*XX;


*J2F208**12*001*31*121156 CUST FO8*425 14TH STREET NW***ATLANTA**GA*30318*PL*XX;
                                                                               
MCN = J2F208                                                                   
SFX =                                                                           
SO = 12                                                                         
BG = 001                                                                       
CYC = 31                                                                       
NAME = 121156 CUST FO8                                                         
ADDR =                                                                         
ADDR2 =                                                                         
CITY =                                                                         
FRNG =                                                                         
ST =                                                                           
ZIP =                                                                           
BILLER ID =                                                                     
TYA =