|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 7040 (0x1b80)
Types: TextFile
Names: »FORMS2.GN2«
└─⟦feb517505⟧ Bits:30005663 FORMS-2 v. 1.3 rev 5 for CIS-COBOL (RC702)
└─ ⟦this⟧ »FORMS2.GN2«
01 CURSOR-POSITION PIC 9(4) VALUE ZERO.
01 INDICATORS.
02 CURRENT-RECORD PIC X(3) VALUE "NO".
02 END-OF-FILE PIC X(3) VALUE "NO".
02 KEY-CHANGED PIC X(3).
02 DATA-CHANGED PIC X(3).
01 COMMENT PIC X(40) VALUE SPACE.
01 FILE-STATUS.
02 STATUS-1 PIC 9.
02 STATUS-2 PIC X.
01 BINARY-FIELD.
02 BINARY-ZERO PIC X VALUE LOW-VALUE.
02 BINARY-CHAR PIC X.
01 BINARY-NO REDEFINES BINARY-FIELD PIC 9(4) COMP.
01 DECIMAL-NO PIC 9(3).
01 LOCKED PIC X VALUE "D".
/
PROCEDURE DIVISION.
START-UP.
DISPLAY SPACE UPON CRT.
PERFORM SET-UP-FILE-NAME.
OPEN I-O INDEXED-FILE.
PERFORM CHECK-STATUS.
MOVE SPACE TO INDEXED-RECORD.
MOVE SPACE TO SAVED-RECORD.
PERFORM DISPLAY-FORM.
GO TO NO-CURRENT-RECORD.
ACCEPT-FROM-SCREEN.
MOVE START-OF-DATA TO CURSOR-POSITION.
PERFORM ACCEPT-RECORD THRU SET-UP-RECORD.
IF RECORD-KEY NOT = SAVED-KEY
MOVE "YES" TO KEY-CHANGED
ELSE MOVE "NO" TO KEY-CHANGED.
IF RECORD-DATA NOT = SAVED-DATA
MOVE "YES" TO DATA-CHANGED
ELSE MOVE "NO" TO DATA-CHANGED.
MOVE INDEXED-RECORD TO SAVED-RECORD.
IF KEY-CHANGED = "YES" GO TO SEE-IF-RECORD-EXISTS.
IF DATA-CHANGED = "YES" GO TO UPDATE-RECORD.
IF END-OF-FILE = "YES" GO TO CLOSE-DOWN.
IF CURRENT-RECORD = "NO" GO TO SEE-IF-ANY-MORE-RECORDS.
IF CURRENT-RECORD = "DUP" GO TO REPLACE-RECORD.
IF CURRENT-RECORD = "LOK"
THEN IF CURSOR-POSITION = START-OF-DATA
GO TO SEE-IF-RECORD-EXISTS
ELSE GO TO SEE-IF-ANY-MORE-RECORDS.
IF CURSOR-POSITION NOT = START-OF-KEY
GO TO SEE-IF-ANY-MORE-RECORDS.
*DELETE-RECORD.
DELETE INDEXED-FILE.
PERFORM CHECK-STATUS.
MOVE "RECORD DELETED" TO COMMENT.
MOVE SAVED-KEY TO RECORD-KEY.
GO TO NO-CURRENT-RECORD.
SEE-IF-ANY-MORE-RECORDS.
START INDEXED-FILE KEY > RECORD-KEY
INVALID GO TO END-OF-FILE-REACHED.
IF STATUS-2 NOT = LOCKED PERFORM CHECK-STATUS.
READ INDEXED-FILE NEXT.
IF STATUS-2 = LOCKED GO TO RECORD-LOCKED.
PERFORM CHECK-STATUS.
GO TO CLEAR-COMMENT.
END-OF-FILE-REACHED.
MOVE "END OF FILE - RETURN WILL TERMINATE"
TO COMMENT.
MOVE "YES" TO END-OF-FILE.
MOVE SPACE TO RECORD-KEY.
GO TO NO-CURRENT-RECORD.
REPLACE-RECORD.
IF CURSOR-POSITION = END-OF-DATA GO TO AMEND-RECORD.
IF CURSOR-POSITION = START-OF-KEY GO TO AMEND-RECORD.
MOVE "YES" TO CURRENT-RECORD.
GO TO SEE-IF-RECORD-EXISTS.
UPDATE-RECORD.
IF CURRENT-RECORD = "LOK" GO TO WRITE-NEW-RECORD.
IF CURRENT-RECORD NOT = "YES" GO TO SEE-IF-RECORD-EXISTS.
AMEND-RECORD.
REWRITE INDEXED-RECORD INVALID GO TO WRITE-NEW-RECORD.
IF STATUS-2 = LOCKED
MOVE "EXISTING RECORD LOCKED" TO COMMENT
GO TO DUPLICATE-RECORD.
PERFORM CHECK-STATUS.
IF CURRENT-RECORD = "DUP"
MOVE "RECORD REPLACED" TO COMMENT
ELSE MOVE "RECORD AMENDED" TO COMMENT.
GO TO RE-ESTABLISH-LOCK.
SEE-IF-RECORD-EXISTS.
READ INDEXED-FILE INVALID GO TO SEE-IF-NEW-RECORD.
IF STATUS-2 NOT = LOCKED PERFORM CHECK-STATUS.
IF DATA-CHANGED = "NO" GO TO SEE-IF-UPDATE-ATTEMPTED.
RECORD-ALREADY-EXISTS.
MOVE "RECORD ALREADY EXISTS WITH THIS KEY" TO COMMENT.
DUPLICATE-RECORD.
MOVE SAVED-RECORD TO INDEXED-RECORD.
MOVE "DUP" TO CURRENT-RECORD.
GO TO NOT-END-OF-FILE.
SEE-IF-UPDATE-ATTEMPTED.
IF CURRENT-RECORD = "DUP" GO TO RECORD-ALREADY-EXISTS.
IF CURSOR-POSITION = END-OF-DATA
GO TO RECORD-ALREADY-EXISTS.
IF CURSOR-POSITION = START-OF-KEY
GO TO RECORD-ALREADY-EXISTS.
IF STATUS-2 = LOCKED GO TO RECORD-LOCKED.
CLEAR-COMMENT.
MOVE SPACE TO COMMENT.
GO TO SET-CURRENT-RECORD.
RECORD-LOCKED.
MOVE "RECORD LOCKED" TO COMMENT.
MOVE "LOK" TO CURRENT-RECORD.
GO TO CLEAR-DATA.
SEE-IF-NEW-RECORD.
MOVE SAVED-RECORD TO INDEXED-RECORD.
IF DATA-CHANGED = "YES" GO TO WRITE-NEW-RECORD.
IF CURRENT-RECORD = "DUP" GO TO WRITE-NEW-RECORD.
IF CURSOR-POSITION = END-OF-DATA GO TO WRITE-NEW-RECORD.
IF CURSOR-POSITION = START-OF-KEY GO TO WRITE-NEW-RECORD.
RECORD-NOT-FOUND.
MOVE "RECORD NOT FOUND" TO COMMENT.
MOVE "NO" TO END-OF-FILE.
NO-CURRENT-RECORD.
MOVE "NO" TO CURRENT-RECORD.
CLEAR-DATA.
MOVE SPACE TO RECORD-DATA.
PERFORM SET-UP-SCREEN.
PERFORM SET-UP-RECORD.
GO TO SAVE-RECORD-AREA.
WRITE-NEW-RECORD.
WRITE INDEXED-RECORD INVALID GO TO RECORD-ALREADY-EXISTS.
IF STATUS-2 = LOCKED GO TO RECORD-ALREADY-EXISTS.
PERFORM CHECK-STATUS.
MOVE "NEW RECORD WRITTEN" TO COMMENT.
RE-ESTABLISH-LOCK.
READ INDEXED-FILE INVALID GO TO RECORD-NOT-FOUND.
IF STATUS-2 = LOCKED PERFORM DISPLAY-COMMENT
GO TO RECORD-LOCKED.
PERFORM CHECK-STATUS.
SET-CURRENT-RECORD.
MOVE "YES" TO CURRENT-RECORD.
NOT-END-OF-FILE.
MOVE "NO" TO END-OF-FILE.
SAVE-RECORD-AREA.
MOVE INDEXED-RECORD TO SAVED-RECORD.
PERFORM SET-UP-SCREEN THRU DISPLAY-RECORD.
DISPLAY-COMMENT.
DISPLAY COMMENT AT COMMENT-POSITION.
GO-TO-ACCEPT.
GO TO ACCEPT-FROM-SCREEN.
CHECK-STATUS.
IF FILE-STATUS NOT = ZERO
MOVE STATUS-2 TO BINARY-CHAR
MOVE BINARY-NO TO DECIMAL-NO
DISPLAY SPACE UPON CRT
DISPLAY "FILE ERROR " STATUS-1 "/" DECIMAL-NO
UPON CONSOLE
GO TO CLOSE-FILE.
CLOSE-DOWN.
DISPLAY SPACE UPON CRT.
CLOSE-FILE.
CLOSE INDEXED-FILE.
EXIT-PROGRAM.
EXIT PROGRAM.
STOP-RUN.
DISPLAY "RUN TERMINATED" UPON CONSOLE.
STOP RUN.
*
SET-UP-FILE-NAME.
«eof»