IDENTIFICATION DIVISION. PROGRAM-ID. COB_ZILL_ENTRY_SUB. AUTHOR. Roland Hughes. DATE-WRITTEN. 2005-02-09. DATE-COMPILED. TODAY. ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT DRAW-IDX ASSIGN TO 'MY_MEGA_FILE' ORGANIZATION IS INDEXED ACCESS MODE IS DYNAMIC RECORD KEY IS DRAW_DT IN DRAWING_RECORD ASCENDING LOCK MODE IS AUTOMATIC FILE STATUS IS IN-STAT. DATA DIVISION. FILE SECTION. FD DRAW-IDX IS GLOBAL LABEL RECORDS ARE STANDARD. COPY 'CDD_RECORDS.DRAWING_RECORD' FROM DICTIONARY. ********** * Data declarations ********** WORKING-STORAGE SECTION. 01 CONSTANTS. 05 KEY_PAD_MODE PIC 9 COMP VALUE 0. 05 ACTION-ADD PIC 9 COMP VALUE 2. 05 ACTION-FIND PIC 9 COMP VALUE 3. 05 ACTION-DELETE PIC 9 COMP VALUE 4. 05 ACTION-UPDATE PIC 9 COMP VALUE 5. 05 ACTION-EXIT PIC 9 COMP VALUE 99. 01 STATUS-VARIABLES. 05 IN-STAT PIC X(2). 05 EOF-FLAG PIC X. 88 IT-IS-END-OF-FILE VALUE 'Y'. 05 DONE-FLAG PIC X. 88 WE-ARE-DONE VALUE 'Y'. 05 FOUND-FLAG PIC X. 88 NOT-FOUND VALUE 'N'. 88 FOUND VALUE 'Y'. 01 STUFF. 05 WORK-STR PIC X(80). 05 TERMINATOR PIC S9(9) COMP. 05 B-ACTION PIC S99 COMP. 05 WORK-NO PIC Z9. 05 CURRENT-MODE PIC S9 COMP. 88 ADD-MODE VALUE 0. 88 DELETE-MODE VALUE 3. 88 FIND-MODE VALUE 2. 88 INVALID-MODE VALUE -1. 01 SCREEN-REC. 05 DRAW-DT PIC X(8). 05 NO-1 PIC XX. 05 NO-2 PIC XX. 05 NO-3 PIC XX. 05 NO-4 PIC XX. 05 NO-5 PIC XX. 05 MEGA-NO PIC XX. 05 MSG-TXT PIC X(60). * * FMS definitions * COPY 'COBFDVDEF' OF 'MEGA_OBJ:MEGA_TXT.TLB'. LINKAGE SECTION. 01 FMS-STUFF. 05 FMSSTATUS PIC S9(9) COMP. 05 RMSSTATUS PIC S9(9) COMP. 05 TCA PIC X(12). 05 WORKSPACE PIC X(12). PROCEDURE DIVISION USING FMS-STUFF. A000-MAIN. PERFORM B000-HSK. MOVE SPACES TO DRAWING_RECORD. PERFORM B010-USER-INPUT UNTIL WE-ARE-DONE. CLOSE DRAW-IDX. EXIT PROGRAM. ***** * Paragraph to initialize our data and files. ***** B000-HSK. CALL 'COB_FILL_IN_LOGICALS'. MOVE SPACES TO STATUS-VARIABLES. CALL 'FDV$SPADA' USING BY REFERENCE KEY_PAD_MODE. CALL 'FDV$CDISP' USING BY DESCRIPTOR 'ZILL_ENTRY2'. MOVE SPACES TO SCREEN-REC. OPEN I-O DRAW-IDX. SET ADD-MODE TO TRUE. ***** * Paragraph to handle user interaction. ***** B010-USER-INPUT. MOVE SPACES TO WORK-STR. CALL 'FDV$GETAL' USING BY DESCRIPTOR SCREEN-REC BY REFERENCE TERMINATOR. PERFORM C000-CHECK-TERMINATOR. EVALUATE B-ACTION WHEN ACTION-ADD SET ADD-MODE TO TRUE PERFORM C010-ADD-RECORD WHEN ACTION-FIND SET FIND-MODE TO TRUE PERFORM C020-FIND-RECORD WHEN ACTION-DELETE PERFORM C030-DELETE-RECORD SET DELETE-MODE TO TRUE WHEN ACTION-UPDATE IF FIND-MODE PERFORM C040-UPDATE-RECORD ELSE MOVE 'Must be in find mode to update' TO MSG-TXT PERFORM U000-DISPLAY-ERROR END-IF SET ADD-MODE TO TRUE WHEN ACTION-EXIT SET WE-ARE-DONE TO TRUE END-EVALUATE. ***** * Paragraph to test terminator value and set mode. ***** C000-CHECK-TERMINATOR. EVALUATE TERMINATOR WHEN FDV$K_FK_F7 MOVE ACTION-ADD TO B-ACTION WHEN FDV$K_FK_F8 MOVE ACTION-FIND TO B-ACTION WHEN FDV$K_FK_F9 MOVE ACTION-DELETE TO B-ACTION WHEN FDV$K_FK_F10 MOVE ACTION-EXIT TO B-ACTION WHEN FDV$K_FK_F11 MOVE ACTION-UPDATE TO B-ACTION WHEN OTHER MOVE ACTION-ADD TO B-ACTION END-EVALUATE. ***** * Paragraph to actuall add a record to the indexed file ***** C010-ADD-RECORD. PERFORM D000-RETRIEVE-DATA. IF MEGA_NO IN DRAWING_RECORD <= 0 MOVE 'must enter all fields' to MSG-TXT PERFORM U000-DISPLAY-ERROR ELSE WRITE DRAWING_RECORD INVALID KEY MOVE 'Error writing record' TO MSG-TXT PERFORM U000-DISPLAY-ERROR END-WRITE MOVE SPACES TO SCREEN-REC CALL 'FDV$PUTAL' USING BY DESCRIPTOR SCREEN-REC END-IF. ***** * Paragraph to find a record in the file ***** C020-FIND-RECORD. MOVE DRAW-DT IN SCREEN-REC TO DRAW_DT IN DRAWING_RECORD. SET FOUND TO TRUE. START DRAW-IDX KEY IS >= DRAW_DT IN DRAWING_RECORD INVALID KEY MOVE 'Record not found' TO MSG-TXT SET NOT-FOUND TO TRUE PERFORM U000-DISPLAY-ERROR. IF FOUND READ DRAW-IDX NEXT WITH LOCK AT END SET IT-IS-END-OF-FILE TO TRUE END-READ MOVE SPACES TO SCREEN-REC MOVE DRAW_DT IN DRAWING_RECORD TO DRAW-DT IN SCREEN-REC MOVE NO_1 IN DRAWING_RECORD TO WORK-NO MOVE WORK-NO TO NO-1 IN SCREEN-REC MOVE NO_2 IN DRAWING_RECORD TO WORK-NO MOVE WORK-NO TO NO-2 IN SCREEN-REC MOVE NO_3 IN DRAWING_RECORD TO WORK-NO MOVE WORK-NO TO NO-3 IN SCREEN-REC MOVE NO_4 IN DRAWING_RECORD TO WORK-NO MOVE WORK-NO TO NO-4 IN SCREEN-REC MOVE NO_5 IN DRAWING_RECORD TO WORK-NO MOVE WORK-NO TO NO-5 IN SCREEN-REC MOVE MEGA_NO IN DRAWING_RECORD TO WORK-NO MOVE WORK-NO TO MEGA-NO IN SCREEN-REC CALL 'FDV$PUTAL' USING BY DESCRIPTOR SCREEN-REC END-IF. ***** * Paragraph to delete a record from the file ***** C030-DELETE-RECORD. IF NOT FIND-MODE MOVE 'Must find before deleting' to MSG-TXT PERFORM U000-DISPLAY-ERROR ELSE DELETE DRAW-IDX RECORD INVALID KEY MOVE 'Unable to delete record' TO MSG-TXT PERFORM U000-DISPLAY-ERROR END-DELETE MOVE SPACES TO SCREEN-REC CALL 'FDV$PUTAL' USING BY DESCRIPTOR SCREEN-REC END-IF. ***** * Paragraph to update a record on file ***** C040-UPDATE-RECORD. PERFORM D000-RETRIEVE-DATA. REWRITE DRAWING_RECORD INVALID KEY MOVE 'Unable to update record' TO MSG-TXT PERFORM U000-DISPLAY-ERROR. ***** * Paragraph to read data from screen buffer ***** D000-RETRIEVE-DATA. MOVE DRAW-DT IN SCREEN-REC TO DRAW_DT IN DRAWING_RECORD. COMPUTE NO_1 IN DRAWING_RECORD = FUNCTION NUMVAL( NO-1 IN SCREEN-REC). COMPUTE NO_2 IN DRAWING_RECORD = FUNCTION NUMVAL( NO-2 IN SCREEN-REC). COMPUTE NO_3 IN DRAWING_RECORD = FUNCTION NUMVAL( NO-3 IN SCREEN-REC). COMPUTE NO_4 IN DRAWING_RECORD = FUNCTION NUMVAL( NO-4 IN SCREEN-REC). COMPUTE NO_5 IN DRAWING_RECORD = FUNCTION NUMVAL( NO-5 IN SCREEN-REC). COMPUTE MEGA_NO IN DRAWING_RECORD = FUNCTION NUMVAL( MEGA-NO IN SCREEN-REC). ***** * Utility paragraph to display error messages ***** U000-DISPLAY-ERROR. CALL 'FDV$BELL'. CALL 'FDV$PUT' USING BY DESCRIPTOR MSG-TXT BY DESCRIPTOR 'MSG_TXT'. CALL 'FDV$WAIT'. MOVE SPACES TO MSG-TXT. CALL 'FDV$PUT' USING BY DESCRIPTOR MSG-TXT BY DESCRIPTOR 'MSG_TXT'. END PROGRAM COB_ZILL_ENTRY_SUB. ***** * Function to handle drawing range validation ***** IDENTIFICATION DIVISION. PROGRAM-ID. DRAWING_RANGE INITIAL. AUTHOR. Roland Hughes. DATE-WRITTEN. 2005-02-09. DATE-COMPILED. TODAY. ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. DATA DIVISION. FILE SECTION. ********** * Data declarations ********** WORKING-STORAGE SECTION. 01 FMS-STRING-FIELDS. 05 FORM-NAME PIC X(31). 05 UAR-VALS PIC X(80). 05 FIELD-NAME PIC X(31). 05 DATA-LINE. 10 FLD-VAL-STR PIC X(2). 10 FILLER PIC X(130). 01 FMS-BINARY-FIELDS. 05 TERMINATOR PIC S9(9) COMP. 05 TCA-PTR PIC S9(9) COMP. 05 WORKSPACE-PTR PIC S9(9) COMP. 05 CURSOR-POS PIC S9(9) COMP. 05 INSERT-OVER PIC S9(9) COMP. 05 HELP-NUM PIC S9(9) COMP. 05 FLD-IDX PIC S9(9) COMP. 05 RETURN-STATUS PIC S9(9) COMP. 01 STUFF. 05 FLD-VAL PIC 99. * * FMS definitions * COPY 'COBFDVDEF' OF 'MEGA_OBJ:MEGA_TXT.TLB'. PROCEDURE DIVISION GIVING RETURN-STATUS. A000-CHECK-RANGE. CALL 'FDV$RETCX' USING BY REFERENCE TCA-PTR BY REFERENCE WORKSPACE-PTR BY DESCRIPTOR FORM-NAME BY DESCRIPTOR UAR-VALS BY REFERENCE CURSOR-POS BY REFERENCE TERMINATOR BY REFERENCE INSERT-OVER BY REFERENCE HELP-NUM. CALL 'FDV$RETFN' USING BY DESCRIPTOR FIELD-NAME BY REFERENCE FLD-IDX. CALL 'FDV$RET' USING BY DESCRIPTOR DATA-LINE BY DESCRIPTOR FIELD-NAME BY REFERENCE FLD-IDX. IF DATA-LINE IS EQUAL TO SPACES MOVE FDV$K_UVAL_FAIL TO RETURN-STATUS ELSE COMPUTE FLD-VAL = FUNCTION NUMVAL( DATA-LINE) IF FLD-VAL >= 1 AND FLD-VAL <= 52 MOVE FDV$K_UVAL_SUC TO RETURN-STATUS ELSE MOVE FDV$K_UVAL_FAIL TO RETURN-STATUS. END PROGRAM DRAWING_RANGE.