|
IDENTIFICATION DIVISION.
PROGRAM-ID. NSRCHPGM.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
77 WS-PROGRAM-ID PIC X(18) VALUE 'NSRCHPGM- 08/11/96'.
01 MISC-WORK.
05 WS-CICS-RESPONSE1 PIC S9(8) COMP VALUE 0.
05 WS-XCTL-FIELD PIC X(8) VALUE SPACES.
05 WS-DUMMY-FIELD PIC X VALUE SPACES.
05 WS-DUMMY-LENGTH PIC S9(4) COMP VALUE 0.
05 WS-HOLD-MSG PIC X(79) VALUE SPACES.
01 QID-NAME.
05 QID-TRMID PIC XXXX.
05 FILLER PIC XXXX.
01 DEFINE-SERVICE PIC X(08) VALUE 'NAME1 '.
01 ANAME-IN PIC X(256) VALUE 'RICH WAGNER'.
01 BNAME-IN PIC X(256) VALUE 'BILL YARA '.
01 NAME-OUT PIC X(256) VALUE SPACES.
01 WORD-STACK.
05 WORD-ST-ELEM OCCURS 10 INDEXED BY INDX.
10 WORD-ST PIC X(24).
10 WORD-INDICATOR PIC X(1).
01 PHON-STACK.
05 PHON-ST-ELEM OCCURS 10 INDEXED BY INDX1.
10 PHON-ST PIC X(24).
10 PHON-INDICATOR PIC X(1).
01 KEY-COUNT PIC 9(02).
01 MAX-VAL PIC X(03).
01 MIN-VAL PIC X(03).
01 AVG-VAL PIC X(03).
01 MED-VAL PIC X(03).
01 RUN-LENGTH PIC X(02) VALUE '01'.
01 RUN-STEP PIC X(02) VALUE '04'.
01 A-LENGTH PIC X(03) VALUE '020'.
01 B-LENGTH PIC X(03) VALUE '020'.
01 MIN-RUN PIC X(02) VALUE '02'.
01 MIN-PCT PIC X(02) VALUE '50'.
01 KEY-STACK.
05 MATCHER-KEY-STACK OCCURS 30 INDEXED BY INDX2.
10 MATCHER-KEY PIC X(10).
01 SEARCH-TABLE.
05 MATCHER-RANGE OCCURS 30 INDEXED BY INDX3.
10 FROM-RANGE PIC X(10).
10 TO-RANGE PIC X(10).
10 RANGE-IND.
20 RANGE-FIRST PIC X(02).
20 RANGE-REST PIC X(03).
01 COMPARE-RESULT.
05 COMP-RES-ELEM OCCURS 18.
10 PERCENT PIC X(3).
01 WORK-AREA PIC X(3000).
01 WS-COMMAREA.
05 WS-RIDFLD PIC X(14).
05 MAP-TYPE PIC X(7).
05 END-KEY.
10 IST-PART PIC X(10).
10 FILLER PIC X(4).
01 COMM-DATA-LENGTH PIC S9(4) COMP VALUE 35.
01 ISTIN-RECORD.
05 KEYOT.
10 N-KEY PIC X(10).
10 KEY-REST PIC X(4).
05 RECINFOOT.
10 FILLER PIC X(8).
10 TRANS-CODE PIC X(2).
10 DOI PIC X(6).
10 ZA PIC X(2).
10 SS-NUMBER PIC X(9).
10 POL-HLD PIC X(12).
10 FILLER PIC X(15).
05 CNT1OT PIC 99.
05 NAMEOT PIC X(31).
05 REC-ENDOT.
10 FILLER PIC X(2).
10 GROUP-NO PIC X(6).
10 CLAIM-NUMBER PIC X(8).
10 FILLER PIC X(3).
01 ISTOUT-RECORD.
05 RECORD-NUMBER PIC X(2).
05 FILLER PIC X(1).
05 OUT-NAME PIC X(30).
05 CLM-NUMBER PIC X(8).
05 FILLER PIC X(1).
05 INJ-DATE PIC X(6).
05 FILLER PIC X(1).
05 ZA-OUT PIC X(2).
05 FILLER PIC X(1).
05 SS-OUT PIC X(9).
05 FILLER PIC X(1).
05 POL-HOLDER-NAME PIC X(12).
01 REC-COUNT-OUT PIC 9(02) VALUE 1.
*
* COPY NSRCH00.
* COPY RSRCH00.
*
* COPY DFHAID.
* COPY DFHBMSCA.
LINKAGE SECTION.
*
01 DFHCOMMAREA.
05 COM-WS-RIDFLD PIC X(14).
05 COM-MAP-TYPE PIC X(7).
05 COM-KEY PIC X(14).
05 FILLER PIC X(100).
*
PROCEDURE DIVISION.
0000-MAINLINE.
MOVE LOW-VALUES TO NSRCH01I.
*
IF EIBCALEN = COMM-DATA-LENGTH
MOVE DFHCOMMAREA TO WS-COMMAREA.
*
PERFORM PROCESS-MAIN-MENU.
GOBACK.
*
PROCESS-MAIN-MENU.
IF MAP-TYPE NOT = 'RSRCH00' THEN
EVALUATE EIBAID
WHEN DFHPF3
PERFORM EXIT-ROUTINE
WHEN DFHCLEAR
PERFORM EXIT-ROUTINE
WHEN DFHPF10
PERFORM DO-SEARCH
WHEN OTHER
PERFORM I-SCREEN
END-EVALUATE
ELSE
EVALUATE EIBAID
WHEN DFHPF3
PERFORM EXIT-ROUTINE
WHEN DFHCLEAR
PERFORM EXIT-ROUTINE
WHEN DFHPF1
PERFORM READ-NEXT-SCREEN
WHEN OTHER
PERFORM I-SCREEN
END-EVALUATE.
*
I-SCREEN.
MOVE 'NSRCH00' TO MAP-TYPE.
MOVE LOW-VALUES TO NSRCH01I.
MOVE -1 TO NSNAMEL.
EXEC CICS
SEND MAP ('NSRCH01')
MAPSET ('NSRCH00')
FROM (NSRCH01I)
CURSOR
ERASE
END-EXEC.
EXEC CICS
RETURN TRANSID('NSRC')
COMMAREA (WS-COMMAREA)
END-EXEC.
*
DO-SEARCH.
MOVE 'RSRCH00' TO MAP-TYPE.
EXEC CICS
RECEIVE MAP('NSRCH01')
MAPSET ('NSRCH00')
INTO(NSRCH01I)
END-EXEC.
MOVE SPACES TO ANAME-IN.
MOVE NSNAMEI TO ANAME-IN.
CALL 'MATCHER' USING
DEFINE-SERVICE,
ANAME-IN,
NAME-OUT,
WORD-STACK,
PHON-STACK,
KEY-COUNT,
KEY-STACK,
SEARCH-TABLE,
WORK-AREA.
MOVE LOW-VALUES TO RSRCH01I.
MOVE -1 TO RSBOT1L.
SET INDX3 TO 1.
SET NAM-INDX TO 1.
MOVE LOW-VALUES TO WS-RIDFLD.
MOVE FROM-RANGE(INDX3) TO WS-RIDFLD.
MOVE HIGH-VALUES TO END-KEY.
MOVE TO-RANGE(INDX3) TO IST-PART.
EXEC CICS STARTBR
DATASET ('TSTIST1')
RIDFLD(WS-RIDFLD)
GENERIC
KEYLENGTH ('10')
GTEQ
RESP (WS-CICS-RESPONSE1)
END-EXEC.
PERFORM FILL-SCREEN THRU FILL-SCREEN-EXIT
VARYING NAM-INDX FROM 1 BY 1
UNTIL NAM-INDX > 19 OR
WS-RIDFLD NOT < END-KEY OR
WS-CICS-RESPONSE1 NOT = DFHRESP(NORMAL).
EXEC CICS ENDBR
DATASET ('TSTIST1')
RESP (WS-CICS-RESPONSE1)
END-EXEC.
EXEC CICS
SEND MAP ('RSRCH01')
MAPSET ('RSRCH00')
FROM (RSRCH01I)
FREEKB
CURSOR
ERASE
END-EXEC.
EXEC CICS
RETURN TRANSID('NSRC')
COMMAREA (WS-COMMAREA)
LENGTH (COMM-DATA-LENGTH)
END-EXEC.
*
*
READ-NEXT-SCREEN.
MOVE LOW-VALUES TO RSRCH01I.
MOVE -1 TO RSBOT1L.
SET INDX3 TO 1.
SET NAM-INDX TO 1.
EXEC CICS STARTBR
DATASET ('TSTIST1')
RIDFLD(WS-RIDFLD)
GTEQ
RESP (WS-CICS-RESPONSE1)
END-EXEC.
PERFORM FILL-SCREEN THRU FILL-SCREEN-EXIT
VARYING NAM-INDX FROM 1 BY 1
UNTIL NAM-INDX > 19 OR
WS-RIDFLD NOT < END-KEY OR
WS-CICS-RESPONSE1 NOT = DFHRESP(NORMAL).
EXEC CICS ENDBR
DATASET ('TSTIST1')
RESP (WS-CICS-RESPONSE1)
END-EXEC.
EXEC CICS
SEND MAP ('RSRCH01')
MAPSET ('RSRCH00')
FROM (RSRCH01I)
FREEKB
CURSOR
ERASE
END-EXEC.
EXEC CICS
RETURN TRANSID('NSRC')
COMMAREA (WS-COMMAREA)
END-EXEC.
*
*
EXIT-ROUTINE.
MOVE EIBTRMID TO QID-TRMID.
EXEC CICS DELETEQ TS
QUEUE (QID-NAME)
RESP (WS-CICS-RESPONSE1)
END-EXEC.
EXEC CICS SEND
FROM (WS-DUMMY-FIELD)
LENGTH (WS-DUMMY-LENGTH)
ERASE
END-EXEC.
EXEC CICS RETURN
END-EXEC.
*
*
FILL-SCREEN.
EXEC CICS READ NEXT
DATASET ('TSTIST1')
INTO (ISTIN-RECORD)
RIDFLD(WS-RIDFLD)
RESP (WS-CICS-RESPONSE1)
END-EXEC.
MOVE SPACES TO ISTOUT-RECORD.
MOVE REC-COUNT-OUT TO RECORD-NUMBER.
ADD 1 TO REC-COUNT-OUT.
MOVE NAMEOT TO OUT-NAME.
MOVE CLAIM-NUMBER TO CLM-NUMBER.
MOVE ZA TO ZA-OUT.
MOVE DOI TO INJ-DATE.
MOVE SS-NUMBER TO SS-OUT.
MOVE POL-HLD TO POL-HOLDER-NAME.
IF WS-RIDFLD < END-KEY
MOVE ISTOUT-RECORD TO SNAM0I(NAM-INDX)
ELSE
MOVE '***END OF NAME LIST***' TO SNAM0I(NAM-INDX).
FILL-SCREEN-EXIT.
¤ Dauer der Verarbeitung: 0.16 Sekunden
(vorverarbeitet)
¤
|
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.
|
