Dialog RESD1 reads input records and acts as a mainline routine, passing control (by means of the application structure) to dialogs RESD2 and ARCD4, as required by the application. RESD1 also writes erroneous input records to a suspense file.
The dialog definition for RESD1 is illustrated below:
The premap process, mapin operation, and response process are shown below.
Dialog RESD1: Premap Process
!********************************************************************** !*RESD1-PM * !* -EXECUTED AT THE BEGINNING OF THE APPLICATION WHEN * !* DLG RESD1 BEGINS EXECUTION. * !* -PERFORMS APPLICATION INITIALIZATION, THEN READS THE FIRST * !* INPUT RECORD. * !********************************************************************** CALL INIT. READ TRANSACTION. ! ! !************************************************* !*SUBROUTINE INIT * !*-INITIALIZE WORK-ARC-ID, WHICH CONTAINS * !* THE ID OF THE MOST RECENTLY READ ARCHIVED * !* EMPLOYEE RECORD. * !*-SET UP FOR TRANSACTION REPORT. * !************************************************* DEFINE INIT. MOVE 0 TO WORK-ARC-ID. MOVE DATE TO WORK-DATE-YYMMDD. MOVE WORK-YY1 TO WORK-YY2. MOVE WORK-MM1 TO WORK-MM2. MOVE WORK-DD1 TO WORK-DD2. MOVE WORK-DATE-MMDDYY TO REPORT-DATE. MOVE 55 TO WORK-LINE-CTR. GOBACK.
Dialog RESD1: Mapin Operation
External field Internal field INPUT-ID.......................>INPUT-ID
Dialog RESD1: Response Process
!**********************************************************************
!*RESD1-RESPONSE *
!* -EXECUTED AFTER DLG RESD1'S MAPIN OPERATION. DEFAULT RESPONSE *
!* PROCESS FOR RESD1. *
!* -PERFORMS MAINLINE PROCESSING OF INPUT RECORD. *
!**********************************************************************
READY USAGE-MODE UPDATE.
!
!
!*************************************************
!*-TERMINATE APPLICATION ON AN EOF CONDITION *
!*************************************************
IF $EOF
DO.
WRITE LOG TEXT '***EOF ON INPUT***'.
LEAVE APPLICATION.
END.
!
!
!*************************************************
!*-INPUT-ID CONTAINS THE ID OF THE EMP REC *
!* TO BE RESTORED. *
!*-ATTEMPT TO RETRIEVE THE RECORD FROM THE *
!* DATABASE. *
!*-IF THE RECORD ALREADY EXISTS, CALL AN *
!* ERROR ROUTINE. *
!*-ON ANY OTHER ERROR, TERMINATE THE APP. *
!*************************************************
MOVE INPUT-ID TO EMP-ID-0415.
OBTAIN CALC EMPLOYEE.
IF DB-STATUS-OK
CALL ERRRTN.
IF DB-REC-NOT-FOUND
NEXT COMMAND.
ELSE
IF DB-ANY-ERROR
ABORT TEXT 'DB ERROR ON EMPLOYEE OBTAIN'.
!
!
!*************************************************
!*-WORK-ARCFILE-STATUS IS SET TO EOF WHEN *
!* THE ARCHIVE FILE HAS REACHED THE EOF. *
!*-NOTFND IS A SUBROUTINE THAT IS CALLED *
!* WHEN THE EMP REC TO BE RESTORED CANNOT BE *
!* FOUND IN THE ARCHIVE FILE. *
!*-IF WORK-ARCFILE-STATUS = EOF, CALL NOTFND. *
!*************************************************
IF WORK-ARCFILE-STATUS = 'EOF'
CALL NOTFND.
!
! !************************************************* !*-PASS CONTROL TO FUNCTION F2, WHICH * !* EXECUTES DIALOG RESD2. * !*-F2 (RESD2) AND F3 (RESD3), WHICH IS A VALID * !* FUNCTION FROM F2, READ THE ARCHIVE FILE * !* AND ATTEMPT TO RESTORE THE EMP REC AND ITS * !* ASSOCIATED COVERAGE RECS. IF THE EMP REC * !* CANNOT BE FOUND, THESE DIALOGS SET WORK- * !* STATUS TO 'NOT FOUND'. * !************************************************* MOVE 'R2' TO AGR-CURRENT-RESPONSE. MOVE SPACES TO WORK-STATUS. EXECUTE NEXT FUNCTION. ! ! !************************************************* !*-IF THE REQUESTED EMP REC WAS NOT FOUND, * !* CALL THE NOTFND ERROR ROUTINE. * !*-IF THE RECORD WAS FOUND AND RESTORED, * !* CALL THE FOUND ROUTINE. * !************************************************* IF WORK-STATUS = 'NOT FOUND' CALL NOTFND. ELSE CALL FOUND. ! ! !************************************************* !*SUBROUTINE ERRRTN * !*-CALLED WHEN THE REQUESTED EMP REC IS * !* ALREADY ON THE DATABASE. * !*-SET UP FOR TRANSACTION REPORT, THEN * !* PASS CONTROL TO FUNCTION F4 (DLG ARCD4), * !* WHICH, ALONG WITH ARCD5, WRITES A REPORT * !* LINE. * !*-SET INPUT-ID OF THE INPUT MAP IN ERROR. * !*-ISSUE WRITE TRANSACTION COMMAND, WHICH * !* WRITES THE INPUT RECORD TO THE SUSPENSE * !* FILE, THEN READS THE NEXT INPUT RECORD. * !************************************************* DEFINE ERRRTN. MOVE 'EMPLOYEE ALREADY ON DATABASE' TO REPORT-STATUS. MOVE INPUT-ID TO REPORT-ID. MOVE EMP-LAST-NAME-0415 TO REPORT-LNAME. MOVE EMP-FIRST-NAME-0415 TO REPORT-FNAME. MOVE 'R4' TO AGR-CURRENT-RESPONSE. EXECUTE NEXT FUNCTION. MODIFY MAP TEMP FOR (INPUT-ID) EDIT ERROR. WRITE TRANSACTION. !
! !************************************************* !*SUBROUTINE NOTFND * !*-CALLED WHEN THE REQUESTED EMP REC IS * !* NOT ON THE ARCHIVE FILE. (NOTE THAT THE * !* APPL. ASSUMES THAT THE INPUT FILE AND * !* ARCHIVE FILE ARE BOTH ORDERED BY EMP ID.) * !*-SET UP FOR TRANSACTION REPORT, THEN * !* PASS CONTROL TO FUNCTION F4 (DLG ARCD4), * !* WHICH, ALONG WITH ARCD5, WRITES A REPORT * !* LINE. * !*-SET INPUT-ID OF THE INPUT MAP IN ERROR. * !*-ISSUE WRITE TRANSACTION COMMAND, WHICH * !* WRITES THE INPUT RECORD TO THE SUSPENSE * !* FILE, THEN READS THE NEXT INPUT RECORD. * !************************************************* DEFINE NOTFND. MOVE 'EMPLOYEE NOT FOUND' TO REPORT-STATUS. MOVE INPUT-ID TO REPORT-ID. MOVE SPACES TO REPORT-LNAME. MOVE SPACES TO REPORT-FNAME. MOVE 'R4' TO AGR-CURRENT-RESPONSE. EXECUTE NEXT FUNCTION. MODIFY MAP TEMP FOR (INPUT-ID) EDIT ERROR. WRITE TRANSACTION. ! ! !************************************************* !*SUBROUTINE FOUND * !*-CALLED WHEN THE REQUESTED EMP REC HAS BEEN * !* FOUND ON THE ARCHIVE FILE AND RESTORED. * !*-SET UP FOR TRANSACTION REPORT, THEN * !* PASS CONTROL TO FUNCTION F4 (DLG ARCD4), * !* WHICH, ALONG WITH ARCD5, WRITES A REPORT * !* LINE. * !*-READ THE NEXT INPUT RECORD. * !************************************************* DEFINE FOUND. MOVE 'EMPLOYEE RESTORED' TO REPORT-STATUS. MOVE INPUT-ID TO REPORT-ID. MOVE EMP-LAST-NAME-0415 TO REPORT-LNAME. MOVE EMP-FIRST-NAME-0415 TO REPORT-FNAME. MOVE 'R4' TO AGR-CURRENT-RESPONSE. EXECUTE NEXT FUNCTION. READ TRANSACTION.
|
Copyright © 2013 CA.
All rights reserved.
|
|