IDENTIFICATION DIVISION.
PROGRAM-ID. UA9PGM1.
REMARKS.
       PROGRAM AUTHOR = WINSTON. Email: [email protected].
       DISPLAYS REQUESTED RECORD ON INPUT OF REGION NO. AND 
       CUSTOMER NO. THEN REFRESHES SCREEN WHEN YOU HIT 'ENTER'.
       CUSTOMER NO. = 0 INDICATES INVALID RECORD, IN WHICH CASE
       SYSTEM WILL REPOSITION CURSOR AT START OF CUSTOMER NO.
       FIELD FOR USER TO REENTER NO. Back

ENVIRONMENT DIVISION.
DATA DIVISION.

WORKING-STORAGE SECTION.
       COPY DFHAID.
       COPY DFHBMSCA.
       COPY UA9MAP1.

01 CUSTOMER-RECORD.
   05 CUS-KEY.
      10 CUS-REGION           PIC X(02).
      10 CUS-NUMBER           PIC X(04).
   05 CUS-ACCT-NAME           PIC X(20).
   05 CUS-ACCT-REP            PIC X(15).
   05 CUS-SALES               PIC 9(08).
   05 FILLER                  PIC X(31).
01 REGION-HEADER-RECORD.
   05 REG-KEY.
      10 REG-REGION           PIC X(02).
      10 REG-ZEROS            PIC X(04).
   05 REG-NAME                PIC X(20).
   05 FILLER                  PIC X(54).
01 SWITCH.
   05 END-PROG                PIC X VALUE 'N'.
   88 END-PROG-SW                   VALUE 'Y'.
01 REG-CUST-KEY.
   05 REGION                  PIC 9(2).
   05 CUSTOMER                PIC 9(4).
01 REC-LENG              COMP PIC S9(4) VALUE +80.
01 TERM-MESSG                 PIC X(20) VALUE ' NORMAL TERMINATION '.
01 PARAM-AREA                 PIC X.

PROCEDURE DIVISION.
   IF EIBCALEN = ZERO 
      PERFORM 100-SEND-MAP 
   ELSE 
      PERFORM 200-RECV-MAP THRU 500-BRANCH2.
   IF EIBAID = DFHCLEAR
      PERFORM 900-END-SESSION
   ELSE
      EXEC CICS
           RETURN TRANSID('U1A9')
      END-EXEC.

100-SEND-MAP.
    MOVE 'ENTER QUERY DATA OR CLEAR TO EXIT' TO MSG0.
    MOVE 'WINSTON' TO STUDO.
    IF EIBAID = DFHCLEAR
       THEN PERFORM 900-END-SESSION.
    EXEC CICS 
         SEND MAP('UA9MAP1') MAPSET('UA9MAP1')
         ERASE 
    END-EXEC.
    EXEC CICS
         RETURN TRANSID ('U1A9')
         COMMAREA (PARAM-AREA)
         LENGTH (1)
    END-EXEC.

200-RECV-MAP.
    EXEC CICS
         HANDLE AID CLEAR (900-END-SESSION)
    END-EXEC.
    EXEC CICS 
         IGNORE CONDITION
         MAPFAIL
    END-EXEC.
    EXEC CICS 
         RECEIVE MAP('UA9MAP1') MAPSET('UA9MAP1')
    END-EXEC.
    MOVE SPACES TO CNAMEO.
    MOVE SPACES TO REPO.
    MOVE ZEROS TO SALESO.
    PERFROM 300-READ-DATA-FILE.
    IF CUS-NUMBER = ZEROS
       PERFORM 600-REENTER-CUSTNUM.
    MOVE 'HIT ENTER TO CONTINUE OR CLEAR TO EXIT' TO MSG0.

400-BRANCH1.
    MOVE 'WINSTON' TO STUDO.
    EXEC CICS 
         SEND MAP('UA9MAP1') MAPSET('UA9MAP1')
         DATAONLY
    END-EXEC.
    MOVE SPACES TO CNAMEO.
    MOVE SPACES TO REPO.
    MOVE ZEROS TO SALESO.
    MOVE SPACES TO REGNO.
    MOVE SPACES TO CUSTO.

500-BRANCH2.
    EXIT.

600-REENTER-CUSTNUM.
    MOVE DFHBMFSE TO REGNA.
    MOVE -1 TO CUSTL.
    MOVE DFHBMBRY TO CUSTA.
    MOVE SPACES TO CNAMEO.
    MOVE 'CUSTNO BE NON-ZERO, REENTER /CLEAR TO EXIT' TO MSG0.
    MOVE '-WINSTON-' TO STUDO.
    EXEC CICS
         SEND MAP('UA9MAP1') MAPSET('UA9MAP1')
         DATAONLY
         CURSOR
    END-EXEC.
    MOVE 4 TO CUSTL.
    MOVE DFHBMUNN TO CUSTA.
    EXEC CICS 
         RETURN TRANSID('U1A9')
         COMMAREA (PARAM-AREA)
         LENGTH (1)
    END-EXEC.

300-READ-DATA-FILE.
    MOVE REGNI TO CUS-REGION.
    MOVE CUSTI TO CUS-NUMBER.
    EXEC CICS 
         HANDLE CONDITION NOTFD (222-NOTFD)
    END-EXEC.
    EXEC CICS
         READ DATASET ('UCBFILE1')
         INTO (CUSTOMER-RECORD)
         LENGTH (REC-LENG)
         RIDFLD (CUS-KEY)
    END-EXEC.
    MOVE CUS-ACCT-NAME TO CNAMEO.
    MOVE CUS-ACCT-REP TO REPO.
    MOVE CUS-SALES TO SALESO.

900-END-SESSION.
    EXEC CICS
         SEND TEXT FROM (TERM-MESSG)
         LENGTH (20)
         ERASE
         FREEKB
    END-EXEC.
    EXEC CICS
         RETURN
    END-EXEC.

222-NOTFD.
    MOVE 'RECD NOT FOUND - HIT ENTER /CLEAR TO EXIT' TO MSGO.
    IF CUS-KEY NOT NUMERIC THEN
       MOVE 'KEYS BE NUMERIC - HIT ENTER /CLEAR TO EXIT' TO MSGO.
    GO TO 400-BRANCH1.