Goto inventory and label index...


Goto data index...


Goto tree view...


Procedure division...


 IDENTIFICATION DIVISION.
 PROGRAM-ID.    DICTIO.

 AUTHOR.        LEIF SVALGAARD.
 DATE-WRITTEN.  97/03/16
     -REVISED:  97/11/29
     -DEFINED:  95/08/02.

 ENVIRONMENT DIVISION.

 CONFIGURATION SECTION.
 SOURCE-COMPUTER. IBM-PC-FUJITSU.
 OBJECT-COMPUTER. IBM-PC-FUJITSU.

 INPUT-OUTPUT SECTION.
 FILE-CONTROL.
     SELECT CURRENT-FILE
         ASSIGN               TO CURRENT-FILENAME
         ORGANIZATION         IS INDEXED
         ACCESS MODE          IS DYNAMIC
         FILE STATUS          IS CUR-FILE-STATUS
         RECORD KEY           IS CURRENT-KEY
         ALTERNATE RECORD KEY IS CURRENT-KEY-A WITH DUPLICATES
         ALTERNATE RECORD KEY IS CURRENT-KEY-B WITH DUPLICATES
         ALTERNATE RECORD KEY IS CURRENT-KEY-C WITH DUPLICATES
     .
     SELECT OUTPUT-FILE
         ASSIGN               TO CURRENT-FILENAME
         ORGANIZATION         IS INDEXED
         ACCESS MODE          IS SEQUENTIAL
         FILE STATUS          IS CUR-FILE-STATUS
         RECORD KEY           IS OUTPUT-KEY
         ALTERNATE RECORD KEY IS OUTPUT-KEY-A WITH DUPLICATES
         ALTERNATE RECORD KEY IS OUTPUT-KEY-B WITH DUPLICATES
         ALTERNATE RECORD KEY IS OUTPUT-KEY-C WITH DUPLICATES
     .

 DATA DIVISION.

 FILE SECTION.

 FD  CURRENT-FILE
     LABEL RECORDS   ARE STANDARD
     RECORD CONTAINS 00104 CHARACTERS
     .
 01  CURRENT-RECORD.
     02  CURRENT-RECORD-FORMAT.
         03  CURRENT-KEY         PIC X(00008).
         03  FILLER              PIC X(00096).
     02  FILLER                  REDEFINES  CURRENT-RECORD-FORMAT.
         03  FILLER              PIC X(00008).
         03  CURRENT-KEY-A       PIC X(00039).
         03  FILLER              PIC X(00057).
     02  FILLER                  REDEFINES  CURRENT-RECORD-FORMAT.
         03  FILLER              PIC X(00016).
         03  CURRENT-KEY-B       PIC X(00031).
         03  FILLER              PIC X(00057).
     02  FILLER                  REDEFINES  CURRENT-RECORD-FORMAT.
         03  FILLER              PIC X(00017).
         03  CURRENT-KEY-C       PIC X(00030).
         03  FILLER              PIC X(00057).

 FD  OUTPUT-FILE
     LABEL RECORDS   ARE STANDARD
     RECORD CONTAINS 00104 CHARACTERS
     .
 01  OUTPUT-RECORD.
     02  OUTPUT-RECORD-FORMAT.
         03  OUTPUT-KEY          PIC X(00008).
         03  FILLER              PIC X(00096).
     02  FILLER                  REDEFINES  OUTPUT-RECORD-FORMAT.
         03  FILLER              PIC X(00008).
         03  OUTPUT-KEY-A        PIC X(00039).
         03  FILLER              PIC X(00057).
     02  FILLER                  REDEFINES  OUTPUT-RECORD-FORMAT.
         03  FILLER              PIC X(00016).
         03  OUTPUT-KEY-B        PIC X(00031).
         03  FILLER              PIC X(00057).
     02  FILLER                  REDEFINES  OUTPUT-RECORD-FORMAT.
         03  FILLER              PIC X(00017).
         03  OUTPUT-KEY-C        PIC X(00030).
         03  FILLER              PIC X(00057).

 WORKING-STORAGE SECTION.

 01  CURRENT-FILENAME.
     02  FILLER                  PIC X(80).

 01  FILESERV-CONTROL.
     02  FILESERV-OPERATION      PIC X.
     02  FILESERV-FEEDBACK       PIC X.
         88  FILE-EXISTS                    VALUE IS SPACE.
         88  FILE-NOT-FOUND                 VALUE IS "N".
     02  FILESERV-PATHNAME       PIC X(8)   VALUE "ETK".
     02  FILESERV-FILENAME       PIC X(8).
     02  FILESERV-EXTENSION      PIC X(3)   VALUE "DIC".
     02  FILESERV-FORMAT         PIC X(8)   VALUE "[X:D4:I4".
     02  FILESERV-BACKUP-FLAG    PIC X      VALUE "N".
     02  FILESERV-FULL-FILENAME  PIC X(80).
     02  FILESERV-MESSAGE.
         03  FILESERV-STATUS     PIC X(2).
         03  FILESERV-PROGRAM    PIC X(8)   VALUE "DICTIO".

 01  STATUS-INDICATORS.
     02  CURRENT-STATE           PIC X      VALUE    "C".
         88  CURRENT-CLOSED                 VALUE IS "C".
         88  CURRENT-OPEN-INPUT             VALUE IS "I".
         88  CURRENT-OPEN-UPDATE            VALUE IS "U".
         88  CURRENT-OPEN                   VALUE IS "I", "U".
         88  CURRENT-RETRIEVING             VALUE IS "R".
     02  CUR-POSITION-STATE      PIC X      VALUE    SPACE.
         88  CURRENT-POSN-OK                VALUE IS "O".
     02  CUR-FILE-STATUS.
         03  CUR-STATUS-1        PIC X      VALUE ZEROES.
         03  CUR-STATUS-2        PIC X      VALUE ZEROES.
     02  FILLER                  PIC X      VALUE    "N".
         88  FORCE-OUTPUT-DIR               VALUE IS "Y".
     02  THE-OPERATION           PIC X.
     02  OUTPUT-STATE            PIC X      VALUE    "C".
         88  OUTPUT-CLOSED                  VALUE IS "C".

 LINKAGE SECTION.

 01  FILEIO-CONTROL.
     02  SESSION-TASK-ID         PIC X(4).
     02  FILEIO-OPERATION        PIC X.
     02  FILEIO-FEEDBACK         PIC X.
         88  NO-ERRORS                      VALUE IS " ".
         88  HARD-ERROR                     VALUE IS "E".
         88  ILLEGAL-OPERATION              VALUE IS "O".
         88  ILLEGAL-MODE                   VALUE IS "M".
         88  RECORD-NOT-PRESENT             VALUE IS "N".
         88  DUPLICATE-RECORD               VALUE IS "D".
         88  ILLEGAL-FILE-USAGE             VALUE IS "U".
         88  RECORD-LOCKED                  VALUE IS "L".

     02  FILEIO-FILENAME         PIC X(8).

     02  POSITION-MODE           PIC X(2).
         88  THIS-RECORD                    VALUE IS "  ".
         88  NEXT-RECORD                    VALUE IS "NR".
         88  PRIOR-RECORD                   VALUE IS "PR".
         88  EQUAL-TO                       VALUE IS "EQ".
         88  GREATER-OR-EQUAL               VALUE IS "GE".
         88  GREATER-THAN                   VALUE IS "GT".
     02  EXCLUSIVE-USE           PIC X.
         88  EXCLUSIVE-ACCESS-WANTED        VALUE IS "Y".
     02  KEY-SELECTOR            PIC X.
         88  PRIMARY-KEY                    VALUE IS " ".
         88  ALTERNATE-KEY-A                VALUE IS "A".
         88  ALTERNATE-KEY-B                VALUE IS "B".
         88  ALTERNATE-KEY-C                VALUE IS "C".

 01  FILEIO-DATA.
     02  FILEIO-DATA-FORMAT.
         03  FILEIO-KEY          PIC X(00008).
         03  FILLER              PIC X(00096).
     02  FILLER                  REDEFINES  FILEIO-DATA-FORMAT.
         03  FILLER              PIC X(00008).
         03  FILEIO-KEY-A        PIC X(00039).
         03  FILLER              PIC X(00057).
     02  FILLER                  REDEFINES  FILEIO-DATA-FORMAT.
         03  FILLER              PIC X(00016).
         03  FILEIO-KEY-B        PIC X(00031).
         03  FILLER              PIC X(00057).
     02  FILLER                  REDEFINES  FILEIO-DATA-FORMAT.
         03  FILLER              PIC X(00017).
         03  FILEIO-KEY-C        PIC X(00030).
         03  FILLER              PIC X(00057).

 PROCEDURE DIVISION
     USING FILEIO-CONTROL
           FILEIO-DATA.
 BEGIN-PROGRAM.
     PERFORM SET-OK
     MOVE FILEIO-OPERATION TO THE-OPERATION

     IF THE-OPERATION = "I"
         PERFORM OPEN-INPUT-FILE
     ELSE
     IF THE-OPERATION = "O"
         PERFORM OPEN-UPDATE-FILE
     ELSE
     IF THE-OPERATION = "N"
         PERFORM OPEN-NEW-FILE
     ELSE
     IF THE-OPERATION = "G"
         PERFORM GET-RECORD
     ELSE
     IF THE-OPERATION = "P"
         PERFORM PUT-RECORD
     ELSE
     IF THE-OPERATION = "W"
         PERFORM WRITE-RECORD
     ELSE
     IF THE-OPERATION = "U"
         PERFORM UPDATE-RECORD
     ELSE
     IF THE-OPERATION = "D"
         PERFORM DELETE-RECORD
         MOVE SPACE TO CUR-POSITION-STATE
     ELSE
     IF THE-OPERATION = "R"
         PERFORM RETRIEVE-FROM-FILE
     ELSE
     IF THE-OPERATION = "C"
         PERFORM CLOSE-FILE
     ELSE
     IF THE-OPERATION = "E"
         PERFORM ERASE-THE-FILE
     ELSE
     IF THE-OPERATION = "F"
         PERFORM FREE-ALL-LOCKS
     ELSE
     IF THE-OPERATION = "B"
         PERFORM BEFORE-USING-RESOURCES
     ELSE
     IF THE-OPERATION = "A"
         PERFORM AFTER-USING-RESOURCES
         MOVE SPACE TO CUR-POSITION-STATE
     ELSE
     IF THE-OPERATION = "S"
         PERFORM GET-CURRENT-STATE
     ELSE
         MOVE "O" TO FILEIO-FEEDBACK
     .
     IF FILESERV-STATUS > SPACE
         MOVE "L" TO FILESERV-OPERATION
         PERFORM CALL-FILESERV
     .
 RETURN-TO-CALLER.
     EXIT PROGRAM
     .

 SET-OK.
     MOVE SPACE  TO FILEIO-FEEDBACK
     MOVE SPACES TO FILESERV-STATUS
     .

******************************************************************

 OPEN-INPUT-FILE.
     IF FILEIO-FILENAME > SPACES
         PERFORM OPEN-INPUT-CURRENT-FILE
     ELSE
         PERFORM INVALID-EMPTY-FILENAME
     .

 OPEN-INPUT-CURRENT-FILE.
     PERFORM PREPARE-FILE
     IF FILE-EXISTS
         MOVE "INPUT" TO CURRENT-STATE
         PERFORM OPEN-THE-INPUT-FILE
         PERFORM CHECK-FILE-STATUS
     ELSE
         MOVE "E" TO FILEIO-FEEDBACK
     .

 PREPARE-FILE.
     PERFORM CLOSE-FILE
     PERFORM PREPARE-FULL-FILENAME
     .

 PREPARE-FULL-FILENAME.
     MOVE FILEIO-FILENAME TO FILESERV-FILENAME
     IF FORCE-OUTPUT-DIR
         MOVE "FORCED"    TO FILESERV-OPERATION
     ELSE
         MOVE "MODIFY"    TO FILESERV-OPERATION
     .
     PERFORM CALL-FILESERV
     MOVE FILESERV-FULL-FILENAME TO CURRENT-FILENAME
     .

 CALL-FILESERV.
     CALL "FILESERV"
         USING FILESERV-CONTROL
     .

 OPEN-THE-INPUT-FILE.
     OPEN INPUT CURRENT-FILE
     .

 CHECK-FILE-STATUS.
     IF CUR-STATUS-1 = ZERO
         MOVE SPACE TO FILEIO-FEEDBACK
     ELSE
     IF CUR-FILE-STATUS = "10" OR "22" OR "23"
         NEXT SENTENCE
     ELSE
         MOVE "E"             TO FILEIO-FEEDBACK
         MOVE CUR-FILE-STATUS TO FILESERV-STATUS
     .

 INVALID-EMPTY-FILENAME.
     MOVE "E"  TO FILEIO-FEEDBACK
     MOVE "FN" TO FILESERV-STATUS
     .

******************************************************************

 OPEN-UPDATE-FILE.
     IF FILEIO-FILENAME > SPACES
         PERFORM OPEN-I-O-CURRENT-FILE
     ELSE
         PERFORM INVALID-EMPTY-FILENAME
     .

 OPEN-I-O-CURRENT-FILE.
     PERFORM PREPARE-FILE
     IF FILE-NOT-FOUND
         PERFORM OPEN-THE-OUTPUT-FILE
         CLOSE CURRENT-FILE
     .
     PERFORM OPEN-THE-I-O-FILE
     MOVE "UPDATE" TO CURRENT-STATE
     PERFORM CHECK-FILE-STATUS
     .

 OPEN-THE-I-O-FILE.
     OPEN I-O CURRENT-FILE
     .

 OPEN-THE-OUTPUT-FILE.
     OPEN OUTPUT CURRENT-FILE
     .

******************************************************************

 OPEN-NEW-FILE.
     IF FILEIO-FILENAME > SPACES
         PERFORM OPEN-FILE-FOR-OUTPUT
     ELSE
         PERFORM INVALID-EMPTY-FILENAME
     .

 OPEN-FILE-FOR-OUTPUT.
     PERFORM PREPARE-FULL-FILENAME
     OPEN OUTPUT OUTPUT-FILE
     PERFORM CHECK-FILE-STATUS
     MOVE "OPEN" TO OUTPUT-STATE
     .

******************************************************************

 WRITE-RECORD.
     MOVE FILEIO-DATA TO OUTPUT-RECORD
     WRITE OUTPUT-RECORD
       INVALID KEY
         MOVE "DUPLICATE" TO FILEIO-FEEDBACK
     .
     PERFORM CHECK-FILE-STATUS
     .

******************************************************************

 GET-RECORD.
     IF CURRENT-OPEN
         PERFORM GET-THE-RECORD
     ELSE
         PERFORM SET-WRONG-STATE-ERROR
     .

 GET-THE-RECORD.
     MOVE FILEIO-DATA TO CURRENT-RECORD
     IF THIS-RECORD OR EQUAL-TO
         PERFORM READ-THIS-RECORD
     ELSE
     IF NEXT-RECORD
         PERFORM READ-NEXT-RECORD
     ELSE
     IF PRIOR-RECORD
         PERFORM READ-PRIOR-RECORD
     ELSE
     IF GREATER-THAN OR GREATER-OR-EQUAL
         PERFORM SET-POSITION
         IF FILEIO-FEEDBACK = SPACE
             PERFORM READ-NEXT-RECORD
         END-IF
     ELSE
         MOVE "MODE" TO FILEIO-FEEDBACK
     .
     PERFORM CHECK-FILE-STATUS
     PERFORM SET-POSITION-STATUS
     IF NO-ERRORS
         MOVE CURRENT-RECORD TO FILEIO-DATA
     .

 READ-THIS-RECORD.
     IF ALTERNATE-KEY-A
         READ CURRENT-FILE RECORD
             KEY IS CURRENT-KEY-A
             INVALID KEY
                 MOVE "NF" TO FILEIO-FEEDBACK
         END-READ
     ELSE
     IF ALTERNATE-KEY-B
         READ CURRENT-FILE RECORD
             KEY IS CURRENT-KEY-B
             INVALID KEY
                 MOVE "NF" TO FILEIO-FEEDBACK
         END-READ
     ELSE
     IF ALTERNATE-KEY-C
         READ CURRENT-FILE RECORD
             KEY IS CURRENT-KEY-C
             INVALID KEY
                 MOVE "NF" TO FILEIO-FEEDBACK
         END-READ
     ELSE
*    IF PRIMARY-KEY
         READ CURRENT-FILE RECORD
             KEY IS CURRENT-KEY
             INVALID KEY
                 MOVE "NF" TO FILEIO-FEEDBACK
         END-READ
     .

 READ-NEXT-RECORD.
     IF CURRENT-POSN-OK
         READ CURRENT-FILE NEXT RECORD
           AT END  MOVE "NF" TO FILEIO-FEEDBACK
     ELSE
         MOVE "NF"           TO FILEIO-FEEDBACK
     .

 READ-PRIOR-RECORD.
     IF CURRENT-POSN-OK
         READ CURRENT-FILE PREVIOUS RECORD
           AT END  MOVE "NF" TO FILEIO-FEEDBACK
     ELSE
         MOVE "NF"           TO FILEIO-FEEDBACK
     .

 SET-POSITION.
     IF GREATER-OR-EQUAL
         PERFORM START-GREATER-EQUAL
     ELSE
     IF GREATER-THAN
         PERFORM START-GREATER-THAN
     .
     PERFORM SET-POSITION-STATUS
     .

 SET-POSITION-STATUS.
     IF NO-ERRORS
         MOVE "OK" TO CUR-POSITION-STATE
     ELSE
         MOVE "NO" TO CUR-POSITION-STATE
     .

 START-GREATER-EQUAL.
     IF ALTERNATE-KEY-A
         START CURRENT-FILE
             KEY IS NOT LESS THAN CURRENT-KEY-A
             INVALID KEY  MOVE "NF" TO FILEIO-FEEDBACK
         END-START
     ELSE
     IF ALTERNATE-KEY-B
         START CURRENT-FILE
             KEY IS NOT LESS THAN CURRENT-KEY-B
             INVALID KEY  MOVE "NF" TO FILEIO-FEEDBACK
         END-START
     ELSE
     IF ALTERNATE-KEY-C
         START CURRENT-FILE
             KEY IS NOT LESS THAN CURRENT-KEY-C
             INVALID KEY  MOVE "NF" TO FILEIO-FEEDBACK
         END-START
     ELSE
*    IF PRIMARY-KEY
         START CURRENT-FILE
             KEY IS NOT LESS THAN CURRENT-KEY
             INVALID KEY  MOVE "NF" TO FILEIO-FEEDBACK
         END-START
     .

 START-GREATER-THAN.
     IF ALTERNATE-KEY-A
         START CURRENT-FILE
             KEY IS GREATER THAN CURRENT-KEY-A
             INVALID KEY  MOVE "NF" TO FILEIO-FEEDBACK
         END-START
     ELSE
     IF ALTERNATE-KEY-B
         START CURRENT-FILE
             KEY IS GREATER THAN CURRENT-KEY-B
             INVALID KEY  MOVE "NF" TO FILEIO-FEEDBACK
         END-START
     ELSE
     IF ALTERNATE-KEY-C
         START CURRENT-FILE
             KEY IS GREATER THAN CURRENT-KEY-C
             INVALID KEY  MOVE "NF" TO FILEIO-FEEDBACK
         END-START
     ELSE
*    IF PRIMARY-KEY
         START CURRENT-FILE
             KEY IS GREATER THAN CURRENT-KEY
             INVALID KEY  MOVE "NF" TO FILEIO-FEEDBACK
         END-START
     .

 SET-WRONG-STATE-ERROR.
     MOVE "E"  TO FILEIO-FEEDBACK
     MOVE "WS" TO FILESERV-STATUS
     .

******************************************************************

 PUT-RECORD.
     IF CURRENT-OPEN-UPDATE
         PERFORM PUT-THE-RECORD
     ELSE
         PERFORM SET-WRONG-STATE-ERROR
     .

 PUT-THE-RECORD.
     MOVE FILEIO-DATA TO CURRENT-RECORD
     WRITE CURRENT-RECORD
       INVALID KEY  MOVE "DUPLICATE" TO FILEIO-FEEDBACK
     .
     PERFORM CHECK-FILE-STATUS
     .

******************************************************************

 UPDATE-RECORD.
     IF CURRENT-OPEN-UPDATE
         PERFORM UPDATE-THE-RECORD
     ELSE
         PERFORM SET-WRONG-STATE-ERROR
     .

 UPDATE-THE-RECORD.
     MOVE FILEIO-DATA TO CURRENT-RECORD
     REWRITE CURRENT-RECORD
       INVALID KEY  MOVE "NF" TO FILEIO-FEEDBACK
     .
     PERFORM CHECK-FILE-STATUS
     .

******************************************************************

 DELETE-RECORD.
     IF CURRENT-OPEN-UPDATE
         PERFORM DELETE-THE-RECORD
     ELSE
         PERFORM SET-WRONG-STATE-ERROR
     .

 DELETE-THE-RECORD.
     MOVE FILEIO-KEY TO CURRENT-KEY
     DELETE CURRENT-FILE RECORD
       INVALID KEY  MOVE "NF" TO FILEIO-FEEDBACK
     .
     PERFORM CHECK-FILE-STATUS
     .

******************************************************************

 RETRIEVE-FROM-FILE.
     IF CURRENT-OPEN
         MOVE "USAGE ERROR" TO FILEIO-FEEDBACK
     ELSE
     IF FILEIO-FILENAME > SPACES
         PERFORM RETRIEVE-RECORD
     ELSE
         MOVE "NOT FOUUND"  TO FILEIO-FEEDBACK
     .

 RETRIEVE-RECORD.
     IF FILEIO-FILENAME NOT = FILESERV-FILENAME
         PERFORM CLOSE-FILE
     .
     IF NOT CURRENT-RETRIEVING
         PERFORM OPEN-INPUT-FILE
     .
     IF NO-ERRORS
         PERFORM GET-THE-RECORD
         MOVE "RETRIEVE" TO CURRENT-STATE
     .

******************************************************************

 CLOSE-FILE.
     MOVE SPACE TO CUR-POSITION-STATE
     IF NOT CURRENT-CLOSED
         CLOSE CURRENT-FILE
         MOVE "CLOSED" TO CURRENT-STATE
     .
     IF NOT OUTPUT-CLOSED
         CLOSE OUTPUT-FILE
         MOVE "CLOSED" TO OUTPUT-STATE
     .
     MOVE SPACES TO FILESERV-FILENAME
     .

******************************************************************

 ERASE-THE-FILE.
     MOVE FILEIO-FILENAME TO FILESERV-FILENAME
     MOVE     "ERASE"     TO FILESERV-OPERATION
     PERFORM CALL-FILESERV
     IF FILESERV-FEEDBACK > SPACE
         MOVE "E" TO FILEIO-FEEDBACK
     .

******************************************************************

 FREE-ALL-LOCKS.
     EXIT
     .

******************************************************************

 BEFORE-USING-RESOURCES.
     EXIT
     .

******************************************************************

 AFTER-USING-RESOURCES.
     EXIT
     .

******************************************************************

 GET-CURRENT-STATE.
     MOVE CURRENT-STATE TO FILEIO-FEEDBACK
     .