IDENTIFICATION DIVISION.
       PROGRAM-ID. PERSONNEL-DATABASE.
       AUTHOR. UGUR AYFER.

       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SOURCE-COMPUTER. PC.
       OBJECT-COMPUTER. PC.

       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT PERSONNEL-FILE ASSIGN TO DISK "PERSONEL.DAT"
                  ORGANIZATION IS LINE SEQUENTIAL.

       DATA DIVISION.
       FILE SECTION.

       FD  PERSONNEL-FILE.
       01  PERS-REC.
           02 ID-NO              PIC X(8).
           02 NAME               PIC X(16).
           02 SURNAME            PIC X(16).
           02 GENDER             PIC X.
           02 DEPT-CODE          PIC X.
           02 NCHILDREN          PIC 99.
           02 HOME-ADR1          PIC X(25).
           02 HOME-ADR2          PIC X(25).
           02 HOME-ADR3          PIC X(25).
           02 HOME-TEL           PIC X(12).
           02 EMPLOYMENT-DATE.
              03 R-DAY             PIC 99.
              03 R-MONTH           PIC 99.
              03 R-YEAR            PIC 9999.
           02 LEAVE-DATE.
              03 R-DAY             PIC 99.
              03 R-MONTH           PIC 99.
              03 R-YEAR            PIC 9999.
           02 LEAVE-REASON         PIC X.

       WORKING-STORAGE SECTION.
       01   DSP-DATE.
            02 R-DAY               PIC 99.
            02 FILLER              PIC X VALUE '/'.
            02 R-MONTH             PIC 99.
            02 FILLER              PIC X VALUE '/'.
            02 R-YEAR              PIC 9999.

       01   SYSTEM-DATE.
            02 YY                PIC 99.
            02 MM                PIC 99.
            02 DD                PIC 99.

       77   W-IDNO               PIC X(10).
       77   W-REASON             PIC X.
       77   W-DAY                PIC 99.
       77   W-MONTH              PIC 99.
       77   W-YEAR               PIC 9999.
       77   THIS-YEAR            PIC 9999.
       77   DUMMY                PIC X.

       PROCEDURE DIVISION.

       PERSONNEL-LEAVING.

           DISPLAY ' ' ERASE.
           OPEN INPUT PERSONNEL-FILE.
           READ PERSONNEL-FILE AT END PERFORM NO-INPUT-FILE.
           CLOSE PERSONNEL-FILE.

           ACCEPT SYSTEM-DATE FROM DATE.
           COMPUTE THIS-YEAR = 1900 + YY.

       GET-IDNO.
           DISPLAY ' ' LINE 1 POSITION 1 ERASE.
           DISPLAY 'Please enter ID Number :'
                   LINE 3 POSITION 5.
           DISPLAY 'Enter 0 or SPACE To Terminate...'
                   LINE 6 POSITION 5 BLINK.

           ACCEPT W-IDNO LINE 3 POSITION 31 PROMPT NO BEEP.
           IF W-IDNO = '0' OR SPACES PERFORM NORMAL-TERMINATION.

       FIND-PERSONNEL-RECORD.
           OPEN I-O PERSONNEL-FILE.

       SEARCH-LOOP.
           READ PERSONNEL-FILE AT END
                       DISPLAY 'ERROR-PERSONNEL RECORD NOT FOUND'
                               LINE 12 POSITION 5
                       DISPLAY 'Hit RETURN Key To Continue '
                               LINE 14 POSITION 5
                       ACCEPT DUMMY
                       CLOSE PERSONNEL-FILE
                       GO TO GET-IDNO.
           IF W-IDNO NOT = ID-NO GO SEARCH-LOOP.

       PERSONNEL-FOUND.

           IF LEAVE-REASON NOT = '0' AND NOT = SPACE
                 DISPLAY 'PERSONNEL ALREADY LEFT!'
                         LINE 20 POSITION 5
                 DISPLAY 'Hit RETURN Key To Continue '
                         LINE 21 POSITION 5
                 ACCEPT DUMMY PROMPT
                 CLOSE PERSONNEL-FILE
                 GO GET-IDNO.

           DISPLAY NAME       LINE 5 POSITION 5 ERASE EOS.
           DISPLAY SURNAME    LINE 5 POSITION 23.
           DISPLAY 'DEPARTMENT : ' LINE 6 POSITION 5.
           DISPLAY  DEPT-CODE LINE 6 POSITION 18.
           MOVE CORRESPONDING EMPLOYMENT-DATE TO DSP-DATE.
           DISPLAY 'EMP.DATE ' LINE 7 POSITION 5.
           DISPLAY DSP-DATE    LINE 7 POSITION 18.
           DISPLAY 'Please Enter Leaving Date : ../../....'
                             LINE 9 POSITION 5.
           DISPLAY 'Enter BLANK Date To Leave Unchanged'
                             LINE 10 POSITION 5.
                 
           ACCEPT W-DAY    LINE 9 POSITION 33 PROMPT '.' NO BEEP.
           ACCEPT W-MONTH  LINE 9 POSITION 36 PROMPT '.' NO BEEP.
           ACCEPT W-YEAR   LINE 9 POSITION 39 PROMPT '.' NO BEEP.

           IF W-DAY = ZERO AND W-MONTH = ZERO AND W-YEAR = ZERO
                     CLOSE PERSONNEL-FILE
                     GO GET-IDNO.

           IF W-DAY < 1 OR > 31 PERFORM ENTRY-ERROR
                                GO PERSONNEL-FOUND.
           IF W-MONTH < 1 OR > 12 PERFORM ENTRY-ERROR
                                GO PERSONNEL-FOUND.
           IF W-YEAR NOT = THIS-YEAR PERFORM ENTRY-ERROR
                                GO PERSONNEL-FOUND.

       GET-REASON.
           DISPLAY 'Please Enter Leaving Reason Code : .'
                             LINE 10 POSITION 5 ERASE EOS.
           DISPLAY '0:Working  1:Resign  2:Retired 3:Xfer  4:Dead'
                             LINE 12 POSITION 5 BLINK.
           ACCEPT W-REASON   LINE 10 POSITION 40 PROMPT '.' NO BEEP.
           IF W-REASON NOT = '0' AND '1' AND '2' AND '3' AND '4'
                             PERFORM ENTRY-ERROR
                             GO GET-REASON.

       ALL-DATA-OK.
           MOVE W-DAY    TO R-DAY   IN LEAVE-DATE,
           MOVE W-MONTH  TO R-MONTH IN LEAVE-DATE.
           MOVE W-YEAR   TO R-YEAR  IN LEAVE-DATE.
           MOVE W-REASON TO LEAVE-REASON.

           REWRITE PERS-REC.

           CLOSE PERSONNEL-FILE.

           GO GET-IDNO.


       NO-INPUT-FILE.
           DISPLAY 'NO PERSONNEL FILE TO PROCESS!'
                   LINE 12 POSITION 20.
           CLOSE PERSONNEL-FILE.
           STOP RUN.

       NORMAL-TERMINATION.
           DISPLAY 'NORMAL TERMINATION'
                   LINE 12 POSITION 20.
           STOP RUN.

       ENTRY-ERROR.
           DISPLAY 'ERROR In Leave Date/Reason Entry. Try Again!'
                   LINE 20 POSITION 20.

           DISPLAY 'Hit RETURN Key To Continue ' LINE 21 POSITION 20.
           ACCEPT DUMMY.


Back to first page...