% VAX-11 Librarian V04-00^(eZe@ A(0 DEFINITIONSMENU4 UTL011C_MENUض珐IDENTIFICATION DIVISION.PROGRAM-ID. DEFINITIONS.AUTHOR. WAYNE CLOUD(INSTALLATION. ELECTROSPACE SYSTEMS, INC.DATE-WRITTEN. 01/02/87O********************************************************************************3* LIBRARY SYSTEM LOGICAL DEFINITION ENTRY / UPDATE*B* This program provides for the maintainence of a file containing =* logical name and their associated equivalence directory(s).*'* MODULES TO BE LINKED TO THIS PROGRAM:8* LIB001S_UPD_DEFINE - The FMS Form used by this program*O**********************************************************************************ENDENVIRONMENT DIVISION.CONFIGURATION SECTION.SOURCE-COMPUTER. VAX-CLUSTER.OBJECT-COMPUTER. VAX-CLUSTER.O*******************************************************************************INPUT-OUTPUT SECTION. FILE-CONTROL./ SELECT DEFINE-FILE ASSIGN TO "DEF_FILE" ORGANIZATION IS INDEXED ACCESS MODE IS DYNAMIC RECORD KEY IS DEF-LOGICAL.DATA DIVISION. FILE SECTION.HFD DEFINE-FILE RECORD VARYING FROM 11 TO 910 DEPENDING ON DEFINE-SIZE.01 DEFINE-RECORD.! 05 DEF-LOGICAL PIC X(010).% 05 DEF-DIRECTORIES PIC X(900).O******************************************************************************** O/******************************************************************************WORKING-STORAGE SECTION.01 SCREEN-RECORD. 05 SCR-LOGICAL PIC X(10)./ 05 SCR-DIRECTORY OCCURS 8 TIMES PIC X(80).01 FMS-COMMON GLOBAL.( 05 FMS-STATUS-FMS PIC S9(9) COMP.( 05 FMS-STATUS-RMS PIC S9(9) COMP.! 05 FMS-TCA-NAME PIC X(12).& 05 FMS-TCA-SIZE PIC S9(5) COMP.5 05 FMS-TERMINAL-CHANNEL PIC S9(5) COMP VALUE 1.& 05 FMS-WORKSPACE-LINK PIC X(12).6 05 FMS-WORKSPACE-SIZE PIC S9(5) COMP VALUE 2000.3 05 FMS-KEYBOARD-COUNT PIC S9(5) COMP VALUE 2. 05 FMS-KEYBOARD-TABLE., 10 FILLER PIC 9(2) COMP VALUE 13.. 10 FILLER PIC 9(2) COMP VALUE 1033., 10 FILLER PIC 9(2) COMP VALUE 11.. 10 FILLER PIC 9(2) COMP VALUE 1037.( 05 FMS-TERMINATOR PIC S9(5) COMP.01 WORK-AREA. 05 DIR-INDEX PIC 9. 05 DIR-POSITION PIC 999. 05 DEFINE-SIZE PIC 999. 05 RESPONSE PIC X. 05 EXIT-FUNCTION PIC X. 05 RECORD-FLAG PIC X. 05 ERROR-FLAG PIC X.O******************************************************************************** O/******************************* ***********************************************PROCEDURE DIVISION.100-MAINLINE SECTION.100-INITIALIZE. PERFORM 9000-START-FMS.& OPEN I-O DEFINE-FILE ALLOWING ALL.7 CALL "FDV$CDISP" USING BY DESCRIPTOR "DEFINITIONS". CALL "FDV$SPON". MOVE "N" TO RECORD-FLAG. 100-PROCESS.K DISPLAY "Add, Change, Inquire, Next, Delete, or End (A,C,I,N,D,or E): " AT LINE 23 WITH NO ADVANCING.- ACCEPT RESPONSE PROTECTED DEFAULT IS "N".% DISPLAY "" ERASE LINE AT LIN E 23. EVALUATE RESPONSE WHEN "A" PERFORM 1000-ADD-CARD" WHEN "C" PERFORM 1100-CHANGE-CARD WHEN "I" PERFORM 1200-INQUIRE WHEN "N" PERFORM 1250-NEXT" WHEN "D" PERFORM 1300-DELETE-CARD WHEN "E" GO TO 100-END-OF-JOB WHEN OTHER CALL "FDV$SIGOP"9 CALL "FDV$PUTL" USING BY DESCRIPTOR "Invalid Response" END-EVALUATE. GO TO 100-PROCESS.100-END-OF-JOB. CALL "FDV$CLEAR". PERFORM 9500-STOP-FMS. CLOSE DEFINE-FILE. STOP RUN.O************************** ****************************************************** O/******************************************************************************1000-ADD-CARD SECTION. 1000-ENTRY. PERFORM 3000-CLEAR-FIELDS. CALL "FDV$SPOFF".6 CALL "FDV$GETAL" USING BY DESCRIPTOR SCREEN-RECORD$ BY REFERENCE FMS-TERMINATOR. CALL "FDV$SPON".1 IF SCR-LOGICAL = SPACES THEN GO TO 1000-EXIT. PERFORM 7000-FORMAT-RECORD. MOVE "N" TO ERROR-FLAG.; WRITE DEFINE-RECORD INVALID KEY  MOVE "Y" TO ERROR-FLAG. IF ERROR-FLAG = "Y" THEN CALL "FDV$SIGOP"B CALL "FDV$PUTL" USING BY DESCRIPTOR "Record Exists -- Not Added"8 ELSE CALL "FDV$PUTL" USING BY DESCRIPTOR "Record Added" END-IF. GO TO 1000-ENTRY. 1000-EXIT. EXIT.O*******************************************************************************1100-CHANGE-CARD SECTION. 1100-ENTRY. IF RECORD-FLAG NOT = "Y" THEN CALL "FDV$SIGOP"% CALL "FDV$PUTL" USING BY DESCRIPTOR- "Record to Chan ge Must be Displayed First" GO TO 1100-EXIT END-IF.6 CALL "FDV$GETAL" USING BY DESCRIPTOR SCREEN-RECORD$ BY REFERENCE FMS-TERMINATOR. PERFORM 7000-FORMAT-RECORD.< REWRITE DEFINE-RECORD INVALID KEY DISPLAY "BAD REWRITE".9 CALL "FDV$PUTL" USING BY DESCRIPTOR "Record Changed". 1100-EXIT. EXIT.O*******************************************************************************1200-INQUIRE SECTION. 1200-ENTRY. PERFORM 3000-CLEAR-FIELDS. CALL "FDV$SPOFF".2 CALL "FDV$GET" USING BY DESCRIPTOR DEF-LOGICAL# BY REFERENCE FMS-TERMINATOR BY DESCRIPTOR "LOGICAL". CALL "FDV$SPON".+ START DEFINE-FILE KEY NOT < DEF-LOGICAL INVALID KEY CALL "FDV$SIGOP"4 CALL "FDV$PUTL" USING BY DESCRIPTOR "End of File" GO TO 1200-EXIT. PERFORM 1250-NEXT. 1200-EXIT. EXIT.O*******************************************************************************1250-NEXT SECTION. 1250-ENTRY. PERFORM 3000-CLEAR-FIELDS. READ DEFINE-FILE NEXT RECORD AT END CALL "FDV$SIGOP"4 CALL "FDV$PUTL" USING BY DESCRIPTOR "End of File" GO TO 1250-EXIT." MOVE SPACES TO SCREEN-RECORD.$ MOVE DEF-LOGICAL TO SCR-LOGICAL. MOVE 1 TO DIR-POSITION.= PERFORM VARYING DIR-INDEX FROM 1 BY 1 UNTIL DIR-INDEX > 8* UNSTRING DEF-DIRECTORIES DELIMITED BY ","9 INTO SCR-DIRECTORY(DIR-INDEX) WITH POINTER DIR-POSITION END-PERFORM.7 CALL "FDV$PUTAL" USING BY DESCRIPTOR SCREEN-RECORD. MOVE "Y" TO RECORD-FLAG. 1250-EXIT. EXIT.O*******************************************************************************1300-DELETE-CARD SECTION. 1300-ENTRY. IF RECORD-FLAG NOT = "Y" THEN CALL "FDV$SIGOP"% CALL "FDV$PUTL" USING BY DESCRIPTOR1 "Record to be Deleted Must be Displayed First" GO TO 1300-EXIT END-IF.8 DISPLAY "Do you want to Delete THIS Record? (Y/N): " AT LINE 23 WITH NO ADVANCING. ACCEPT RESPONSE PROTECTED.% DISPLAY "" ERASE LINE AT LINE 23./ IF RESPONSE NOT = "Y" THEN GO TO 1300-EXIT.8 DELETE DEFINE-FILE INVALID KEY DISPLAY "BAD DELETE". PERFORM 3000-CLEAR-FIELDS.9 CALL "FDV$PUTL" USING BY DESCRIPTOR "Record Deleted". 1300-EXIT. EXIT.O******************************************************************************** O/******************************************************************************3000-CLEAR-FIELDS SECTION. 3000-ENTRY. MOVE "N" TO RECORD-FLAG.! MOVE SPACES TO DEFINE-RECORD. CALL "FDV$PUTDA". 3000-EXIT. EXIT.O*******************************************************************************7000-FORMAT-RECORD SECTION. 7000-ENTRY.$ MOVE SCR-LOGICAL TO DEF-LOGICAL.$ MOVE SPACES TO DEF-DIRECTORIES. MOVE 1 TO DIR-POSITION.= PERFORM VARYING DIR-INDEX FROM 1 BY 1 UNTIL DIR-INDEX > 8) IF SCR-DIRECTORY(DIR-INDEX) NOT = SPACES> THEN STRING SCR-DIRECTORY(DIR-INDEX), "," DELIMITED BY SPACE2 INTO DEF-DIRECTORIES WITH POINTER DIR-POSITION END-IF END-PERFORM.+ ADD 8, DIR-POSITION GIVING DEFINE-SIZE. 7000-EXIT. EXIT.O******************************************************************************** O/******************************************************************************9000-START-FMS SECTION. 9000-ENTRY.5 CALL "FDV$SSRV" USING BY REFERENCE FMS-STATUS-FMS$ BY REFERENCE FMS-STATUS-RMS.5 CALL "FDV$ATERM" USING BY DESCRIPTOR FMS-TCA-NAME! BY REFERENCE FMS-TCA-SIZE* BY REFERENCE FMS-TERMINAL-CHANNEL.? CALL "FDV$AWKSP" USING BY DESCRIPTOR FMS-WORKSPACE-LINK ) BY DESCRIPTOR FMS-WORKSPACE-SIZE.; CALL "FDV$DFKBD" USING BY DESCRIPTOR FMS-KEYBOARD-TABLE( BY REFERENCE FMS-KEYBOARD-COUNT. 9000-EXIT. EXIT.O*******************************************************************************9500-STOP-FMS SECTION. 9500-ENTRY.6 CALL "FDV$DTERM" USING BY DESCRIPTOR FMS-TCA-NAME. 9500-EXIT. EXIT.O*******************************************************************************END PROGRAM LIB001C_UPD_DEFINE.ww೮XIDENTIFICATION DIVISION.PROGRAM-ID. MENU.** MENU PROGRAM - MENU.COB* DATE - JULY 7TH, 1987!* AUTHOR - PHILLIP SPINGOLA*F* Any comments, suggestions, or constructive criticism are%* welcome. Give me a call!** PHIL SPINGOLA!* Home - (918) 836-2366$* 4001 1/2 N. Memorial Dr.* Tulsa, Ok. 74115 * !* Work - (918) 581-8566*ENVIRONMENT DIVISION.CONFIGURATION SECTION.SOURCE-COMPUTER. VAX-11.OBJECT-COMPUTER. VAX-11.SPECIAL-NAMES.r SYMBOLIC CHARACTERS BELLS CR ESCAPE LF TAB VOID CTRL-Z-VAL CTRL-N-VAL CTRL-F-VAL CTRL-B-VAL CTRL-L-VAL CTRL-D-VALT ARE 8 14 28 11 10 1 27 15 7 3 13 5.DATA DIVISION.WORKING-STORAGE SECTION.01 BIN_DELAY PIC 9(18) COMP.(01 DELAY PIC X(11) VALUE "0 :10:00.00".01 STAT PIC S9(9) COMP.- 88 STATE-IS-SET VALUE EXTERNAL SS$_WASSET.- 88 STATE-NOT-SET VALUE EXTERNAL SS$_WASCLR.;01 SCREEN_BLANK PIC S9(9) COMP VALUE EXTERNAL SCREEN_BLANK.01 PASS_FLAG PIC X EXTERNAL. 01 WORK-AREA. 03 NUMERIC-INPUT PIC 9.. 03 ALPHA-INPUT REDEFINES NUMERIC-INPUT PIC X.* 03 COLUMN-NUM PIC 99. 03 CTR-1 PIC 99. 03 CTR-2 PIC 99. 03 CTR-3 PIC 99. 03 LONGEST-ITEM PIC 99. 03 RESULT PIC 99. 03 NUM-OF-SPACES PIC 99. 03 NUM-OF-SPACES-2 PIC 99. 03 NUM-OF-SPACES-3 PIC 99. 03 MENU-CTR PIC 99. 03 OLD-MENU-CTR PIC 99. 03 NUM-OUT PIC ZZ9. 03 KEY-OUT PIC ZZ9. 03 EDIT-LINE-NUMBER.! 05 FILLER PIC X VALUE SPACES. 05 EDIT-NUM PIC 9. 05 FILLER PIC XX VALUE "> ".% 03 EDIT-LINE PIC X(79) VALUE SPACES.& 03 BLANK-LINE PIC X(80) VALUE SPACES.* 03 TOP-LINE PIC X(77) VALUEM " lqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqk". 03 MID-LINE. 05 FILLER PIC X(8) VALUE "  x".$ 05 FILLER PIC X(8) VALUE ALL TAB. 05 FILLER PIC X VALUE "x". 03 BOTTOM-LINE PIC X(77) VALUEM " mqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqj".* 03 FUNCTION-KEYS." 05 1ST-CHAR-FUNCTION-KEYS PIC X.% 88 KEY-IS-CTRL-B VALUE CTRL-B-VAL.% 88 KEY-IS-CTRL-D VALUE CTRL-D-VAL.% 88 KEY-IS-CTRL-F VALUE CTRL-F-VAL.& 88 KEY-IS-CTRL-L VALUE CTRL-L-VAL.& 88 KEY-IS-CTRL-N VALUE CTRL-N-VAL. 88 KEY-IS-RETURN VALUE CR. 88 KEY-IS-TAB VALUE TAB., 88 KEY-IS-CTRL-Z VALUE CTRL-Z-VAL.# 05 FUNCTION-KEY PIC XXXX. 88 KEY-IS-ESC VALUE "23~ ". 88 KEY-IS-UP VALUE "A". 88 KEY-IS-DOWN VALUE "B". 88 KEY-IS-RIGHT VALUE "C". 88 KEY-IS-LEFT VALUE "D". 88 KEY-IS-END VALUE "P". 88 KEY-IS-PF2 VALUE "Q". 88 KEY-IS-PF3 VALUE "R". 88 KEY-IS-PF4 VALUE "S". 03 MENU-LINE-COORDINATES.4 05 FILLER PIC X(20) VALUE "04060810121416182022"./ 03 MENU-LINES REDEFINES MENU-LINE-COORDINATES.& 05 MENU-LINE OCCURS 10 TIMES PIC 99. 03 MDY-DATE. 05 MDY-MONTH PIC 99. 05 MDY-DAY PIC 99. 05 MDY-YEAR PIC 99. 03 YMD-DATE. 05 YMD-YEAR PIC 99. 05 YMD-MONTH PIC 99. 05 YMD-DAY PIC 99. 03 DATE-OUT. 05 DATE-OUT-1 PIC 99. 05 FILLER PIC X VALUE "/". 05 DATE-OUT-2 PIC 99. 05 FILLER PIC X VALUE "/". 05 DATE-OUT-3 PIC 99.01 CRT-COMMAND-WORDS. 03 CURSOR_POS.! 05 FILLER PIC X VALUE ESCAPE. 05 FILLER PIC X VALUE "[". 05 CURSOR_ROW PIC 99. 05 FILLER PIC X VALUE ";". 05 CURSOR_COL PIC 99. 05 FILLER PIC X VALUE "H". 03 CURSOR_HOME_AND_CLEAR. 05 CURSOR_HOME." 07 FILLER PIC X VALUE ESCAPE.% 07 FILLER PIC X(5) VALUE "[1;1H". 05 CLEAR_SCREEN." 07 FILLER PIC X VALUE ESCAPE.! 07 FILLER PIC XX VALUE "[J". 03 CLEAR_LINE.! 05 FILLER PIC X VALUE ESCAPE. 05 FILLER PIC XX VALUE "[K". 03 BOLD_ON.! 05 FILLER PIC X VALUE ESCAPE." 05 FILLER PIC XXX VALUE "[1m". 03 BOLD_OFF.! 05 FILLER PIC X VALUE ESCAPE." 05 FILLER PIC XXX VALUE "[0m". 03 SET_SCREEN_WIDE.! 05 FILLER PIC X VALUE ESCAPE.# 05 FILLER PIC X(4) VALUE "[?3h". 03 SET_SCREEN_NARROW.! 05 FILLER PIC X VALUE ESCAPE.# 05 FILLER PIC X(4) VALUE "[?3l". 03 SET_MODE_ANSII.! 05 FILLER PIC X VALUE ESCAPE. 05 FILLER PIC X VALUE "<". 03 SET_MODE_VT52.! 05 FILLER PIC X VALUE ESCAPE.# 05 FILLER PIC X(4) VALUE "[?2l". 03 SET_TOP_LINE_HIGH.! 05 FILLER PIC X VALUE ESCAPE.! 05 FILLER PIC X(4) VALUE "#3". 03 SET_BOTTOM_LINE_HIGH.! 05 FILLER PIC X VALUE ESCAPE.! 05 FILLER PIC X(4) VALUE "#4". 03 SET_LINE_WIDE.! 05 FILLER PIC X VALUE ESCAPE.! 05 FILLER PIC X(4) VALUE "#6". 03 SET_CURSOR_UP.! 05 FILLER PIC X VALUE ESCAPE. 05 FILLER PIC X VALUE "[". 05 FILLER PIC 99 VALUE 1. 05 FILLER PIC X VALUE "A". 03 SET_CURSOR_DOWN.! 05 FILLER PIC X VALUE ESCAPE. 05 FILLER PIC X VALUE "[". 05 FILLER PIC 99 VALUE 1. 05 FILLER PIC X VALUE "B". 03 SET_CURSOR_LEFT.! 05 FILLER PIC X VALUE ESCAPE. 05 FILLER PIC X VALUE "[". 05 FILLER PIC 99 VALUE 1. 05 FILLER PIC X VALUE "D". 03 SET_CURSOR_RIGHT.! 05 FILLER PIC X VALUE ESCAPE. 05 FILLER PIC X VALUE "[". 05 FILLER PIC 99 VALUE 1. 05 FILLER PIC X VALUE "C". 03 SET_SCREEN_ASCII.! 05 FILLER PIC X VALUE ESCAPE. 05 FILLER PIC X VALUE "(". 05 FILLER PIC X VALUE "B". 03 SET_SCREEN_GRAPH.! 05 FILLER PIC X VALUE ESCAPE. 05 FILLER PIC X VALUE "(".! 05 FILLER PIC 9 VALUE ZEROES. 03 SET_AUTO_REPEAT_OFF.! 05 FILLER PIC X VALUE ESCAPE. 05 FILLER PIC XX VALUE "[?". 05 FILLER PIC 9 VALUE 8. 05 FILLER PIC X VALUE "l". 03 SET_AUTO_REPEAT_ON.! 05 FILLER PIC X VALUE ESCAPE. 05 FILLER PIC XX VALUE "[?". 05 FILLER PIC 9 VALUE 8. 05 FILLER PIC X VALUE "h".* 03 BOX-VARIABLES. 05 TOP-ROW PIC S99. 05 TOP-COLUMN PIC S99. 05 BOTTOM-ROW PIC S99. !05 BOTTOM-COLUMN PIC S99.*LINKAGE SECTION.01 NUMBER-OF-ITEMS PIC S99.01 START-BAR PIC S99.01 RESPONSE PIC S99. 01 LINKAGE-FUNCTION-KEY PIC S99.01 MENU-MESSAGE PIC X(82).01 LINKAGE-TABLES. 03 DATA-TABLE OCCURS 11. 05 DATA-LETTER PIC X. 05 DATA-FILLER PIC X(43)./BPROCEDURE DIVISION USING LINKAGE-TABLES NUMBER-OF-ITEMS START-BAR 5 RESPONSE LINKAGE-FUNCTION-KEY MENU-MESSAGE.*PS-> PROCEDURE DIVISION. 0000-MENU.**PS-> MOVE "XRAY #1" TO DATA-TABLE(1).**P "S-> MOVE "BROVO #2" TO DATA-TABLE(2).**PS-> MOVE "FOXTROT #3" TO DATA-TABLE(3).**PS-> MOVE "ECHO #4" TO DATA-TABLE(4).**PS-> MOVE "ALPHA #5" TO DATA-TABLE(5).**PS-> MOVE "CHARLIE #6" TO DATA-TABLE(6).**PS-> MOVE "GOLF #7" TO DATA-TABLE(7).**PS-> MOVE "ECHO2 #8" TO DATA-TABLE(8).**PS-> MOVE "DELTA #9" TO DATA-TABLE(9).%*PS-> MOVE SPACES TO DATA-TABLE(10).3*PS-> *PS-> MOVE "SELECTION #0" TO DATA-TABLE(10).-*PS-> MOVE "TITLE LINE" TO DATA-TABLE(11).#*PS-> MOVE SP#ACES TO MENU-MESSAGE.=*PS-> *PS-> MOVE "------MESSAGE LINE------" TO MENU-MESSAGE.*PS-> MOVE 1 TO START-BAR.!*PS-> MOVE 9 TO NUMBER-OF-ITEMS.* DISPLAY SET_AUTO_REPEAT_OFF. IF DATA-TABLE(10) = SPACES" MOVE "EXIT" TO DATA-TABLE(10). IF MENU-MESSAGE = SPACES^ MOVE "Use Arrow, Tab, Number, or Letter Keys to Select then Press Return" TO MENU-MESSAGE. IF NUMBER-OF-ITEMS > 9 MOVE 9 TO NUMBER-OF-ITEMS. IF START-BAR > 9 MOVE 9 TO START-BAR. IF START-BAR > NUMBER$-OF-ITEMS& MOVE NUMBER-OF-ITEMS TO START-BAR.3 PERFORM VARYING CTR-1 FROM 1 BY 1 UNTIL CTR-1 > 10 MOVE ZEROES TO CTR-2G INSPECT DATA-TABLE(CTR-1) TALLYING CTR-2 FOR CHARACTERS BEFORE " " IF CTR-2 > LONGEST-ITEM  MOVE CTR-2 TO LONGEST-ITEM END-IF END-PERFORM. IF LONGEST-ITEM > 40 MOVE 40 TO LONGEST-ITEM. ADD 6 TO LONGEST-ITEM.- SUBTRACT LONGEST-ITEM FROM 80 GIVING RESULT.5 DIVIDE RESULT BY 2 GIVING NUM-OF-SPACES, COLUMN-NUM. ADD 1 TO COLUMN-NUM. SUB%TRACT 8 FROM NUM-OF-SPACES. SUBTRACT 6 FROM LONGEST-ITEM.* MOVE ZEROES TO CTR-2.D INSPECT DATA-TABLE(11) TALLYING CTR-2 FOR CHARACTERS BEFORE " ". IF CTR-2 > 40 MOVE 40 TO CTR-2.& SUBTRACT CTR-2 FROM 40 GIVING RESULT. IF CTR-2 = ZEROES" MOVE ZEROES TO NUM-OF-SPACES-2 ELSE. DIVIDE RESULT BY 2 GIVING NUM-OF-SPACES-2.* IF MENU-MESSAGE NOT = SPACES MOVE ZEROES TO CTR-3D INSPECT MENU-MESSAGE TALLYING CTR-3 FOR CHARACTERS BEFORE " " IF CTR-3 > 78 & MOVE 78 TO CTR-3 END-IF( SUBTRACT CTR-3 FROM 80 GIVING RESULT IF CTR-3 = ZEROES% MOVE ZEROES TO NUM-OF-SPACES-3 ELSE1 DIVIDE RESULT BY 2 GIVING NUM-OF-SPACES-3."* Convert delay interval to binary, CALL 'SYS$BINTIM' USING BY DESCRIPTOR DELAY BY REFERENCE BIN_DELAY GIVING STAT.8 IF STAT IS FAILURE CALL 'LIB$STOP' USING BY VALUE STAT.1 DISPLAY CURSOR_HOME_AND_CLEAR WITH NO ADVANCING. 1000-DISPLAY. MOVE 3 TO CURSOR_ROW. MOVE 1 TO CURSO'R_COL.7 DISPLAY SET_SCREEN_GRAPH CURSOR_POS WITH NO ADVANCING. DISPLAY TOP-LINE CR LF MID-LINE CR LF MID-LINE CR LF MID-LINE CR LF MID-LINE CR LF MID-LINE CR LF MID-LINE CR LF MID-LINE CR LF MID-LINE CR LF# MID-LINE CR LF WITH NO ADVANCING. DISPLAY MID-LINE CR LF MID-LINE CR LF MID-LINE CR LF MID-LINE CR LF MID-LINE CR LF MID-LINE CR LF MID-LINE CR LF MID-LINE CR LF MID-LINE CR LF MID-LINE CR LF BOTTOM-LINE WITH NO ADVANCING., DISPLAY S (ET_SCREEN_ASCII WITH NO ADVANCING.' DISPLAY CURSOR_HOME WITH NO ADVANCING.*- DISPLAY SET_TOP_LINE_HIGH WITH NO ADVANCING.< DISPLAY CR BLANK-LINE(1:NUM-OF-SPACES-2) WITH NO ADVANCING.8 DISPLAY DATA-TABLE(11)(1:CTR-2) BOLD WITH NO ADVANCING.*6 DISPLAY CR LF SET_BOTTOM_LINE_HIGH WITH NO ADVANCING.< DISPLAY CR BLANK-LINE(1:NUM-OF-SPACES-2) WITH NO ADVANCING.8 DISPLAY DATA-TABLE(11)(1:CTR-2) BOLD WITH NO ADVANCING.*M PERFORM VARYING CTR-1 FROM 1 BY 1 UNTIL CTR-1 > 9 OR CTR-1 > NUMBER-OF-)ITEMS( DISPLAY CR LF LF TAB WITH NO ADVANCING7 DISPLAY BLANK-LINE(1:NUM-OF-SPACES) WITH NO ADVANCING MOVE CTR-1 TO EDIT-NUM, DISPLAY EDIT-LINE-NUMBER WITH NO ADVANCING= DISPLAY DATA-TABLE(CTR-1)(1:LONGEST-ITEM) WITH NO ADVANCING END-PERFORM.* MOVE ZEROES TO EDIT-NUM.E DISPLAY EDIT-LINE-NUMBER LINE 22 COLUMN COLUMN-NUM WITH NO ADVANCING: DISPLAY DATA-TABLE(10)(1:LONGEST-ITEM) WITH NO ADVANCING.* IF MENU-MESSAGE NOT = SPACESO DISPLAY CR BLANK-LINE(1:NUM-OF-SPACES-3) L *INE 24 COLUMN 1 WITH NO ADVANCING9 DISPLAY MENU-MESSAGE(1:CTR-3) BOLD WITH NO ADVANCING.* MOVE START-BAR TO MENU-CTR. MOVE ZEROES TO OLD-MENU-CTR. 4410-LOOP. IF OLD-MENU-CTR NOT = ZEROES! MOVE OLD-MENU-CTR TO EDIT-NUM] DISPLAY EDIT-LINE-NUMBER LINE MENU-LINE(OLD-MENU-CTR) COLUMN COLUMN-NUM WITH NO ADVANCINGF DISPLAY DATA-TABLE(OLD-MENU-CTR)(1:LONGEST-ITEM) WITH NO ADVANCING" DISPLAY " " WITH NO ADVANCING. MOVE MENU-CTR TO EDIT-NUMe DISPLAY EDIT-LINE-NUMBER LINE M+ENU-LINE(MENU-CTR) COLUMN COLUMN-NUM BOLD REVERSED WITH NO ADVANCING.N DISPLAY DATA-TABLE(MENU-CTR)(1:LONGEST-ITEM) BOLD REVERSED WITH NO ADVANCING.- DISPLAY " " BOLD REVERSED WITH NO ADVANCING.$ PERFORM 4000-TT-GET THRU 4009-EXIT. IF PASS_FLAG = "Y" GO TO 1000-DISPLAY. IF KEY-IS-END OR KEY-IS-RETURN GO TO 9000-END-OF-RUN ELSE IF KEY-IS-UP OR KEY-IS-LEFT$ MOVE MENU-CTR TO OLD-MENU-CTR IF MENU-CTR = 1 MOVE 11 TO MENU-CTR END-IF IF MENU,-CTR = 10( ADD 1 NUMBER-OF-ITEMS GIVING MENU-CTR END-IF SUBTRACT 1 FROM MENU-CTR GO TO 4410-LOOP ELSE0 IF KEY-IS-DOWN OR KEY-IS-RIGHT OR KEY-IS-TAB$ MOVE MENU-CTR TO OLD-MENU-CTR$ IF MENU-CTR = NUMBER-OF-ITEMS MOVE 9 TO MENU-CTR END-IF IF MENU-CTR = 10 MOVE ZEROES TO MENU-CTR END-IF ADD 1 TO MENU-CTR  GO TO 4410-LOOP ELSE IF ALPHA-INPUT IS NUMERIC- IF NUMERIC-INPUT > NUMBER-OF-ITEMS -AND$ NUMERIC-INPUT NOT = ZEROES GO TO 4410-LOOP ELSE' MOVE MENU-CTR TO OLD-MENU-CTR# IF NUMERIC-INPUT = ZEROES MOVE 10 TO MENU-CTR ELSE+ MOVE NUMERIC-INPUT TO MENU-CTR END-IF END-IF GO TO 4410-LOOP ELSE * ----------- * alpha input * ----------- IF MENU-CTR = 10 MOVE 1 TO CTR-1  ELSE) IF MENU-CTR = NUMBER-OF-ITEMS AND  ALPHA-INPUT NOT = "E." MOVE 1 TO CTR-1 ELSE" ADD 1 MENU-CTR GIVING CTR-1 END-IF END-IF? PERFORM UNTIL CTR-1 > 9 OR ALPHA-INPUT = DATA-LETTER(CTR-1) ADD 1 TO CTR-1 END-PERFORM- IF CTR-1 > NUMBER-OF-ITEMS AND CTR-1 < 10 GO TO 4410-LOOP END-IF' IF ALPHA-INPUT = DATA-LETTER(CTR-1)$ MOVE MENU-CTR TO OLD-MENU-CTR MOVE CTR-1 TO MENU-CTR ELSE MOVE 1 TO CTR-1I PERFORM UNTIL CTR-1 > MENU-CTR OR ALPHA-INPUT = DATA-LETTER(CTR-1/) ADD 1 TO CTR-1 END-PERFORM0 IF CTR-1 > NUMBER-OF-ITEMS AND CTR-1 < 10 GO TO 4410-LOOP END-IF* IF ALPHA-INPUT = DATA-LETTER(CTR-1)' MOVE MENU-CTR TO OLD-MENU-CTR MOVE CTR-1 TO MENU-CTR END-IF END-IF GO TO 4410-LOOP. 4000-TT-GET. * start timer# CALL 'SYS$SETIMR' USING BY VALUE 0 BY REFERENCE BIN_DELAY BY VALUE SCREEN_BLANK BY VALUE 2 GIVING STAT.8 IF STAT IS FAILURE CALL 'LIB$ST0OP' USING BY VALUE STAT.** accept input MOVE "N" TO PASS_FLAG. MOVE ZEROES TO NUMERIC-INPUT.] ACCEPT ALPHA-INPUT PROTECTED SIZE 1 WITH AUTOTERMINATE WITH NO ECHO DEFAULT IS CURRENT VALUE KEY FUNCTION-KEYS( AT END MOVE "P" TO FUNCTION-KEY.** cancel timer# CALL "SYS$CANTIM" USING BY VALUE 2 BY VALUE 0 GIVING STAT.8 IF STAT IS FAILURE CALL 'LIB$STOP' USING BY VALUE STAT. 4009-EXIT. EXIT.9000-END-OF-RUN. IF MENU-CTR = 10 OR KEY-IS-END" MOVE 21 TO LINKAGE-FUNCTION-KEY MOVE ZEROES TO RESPONSE ELSE IF KEY-IS-RETURN* MOVE ZEROES TO LINKAGE-FUNCTION-KEY MOVE MENU-CTR TO RESPONSE ELSE" MOVE 2 TO LINKAGE-FUNCTION-KEY MOVE ZEROES TO RESPONSE." DISPLAY CURSOR_HOME CLEAR_SCREEN.*PS-> *PS-> MOVE RESPONSE TO NUM-OUT.**PS-> DISPLAY CR LF " NUM = " NUM-OUT.,*PS-> MOVE LINKAGE-FUNCTION-KEY TO KEY-OUT.**PS-> DISPLAY CR LF " KEY = " KEY-OUT.*PS-> DISPLAY CR LF LFE*PS-> " Any comments, sugg2estions, or constructive criticism are"+*PS-> CR LF " welcome. Give me a call!""*PS-> CR LF LF " PHIL SPINGOLA"'*PS-> CR LF " Home - (918) 836-2366"**PS-> CR LF " 4001 1/2 N. Memorial Dr."#*PS-> CR LF " Tulsa, Ok. 74115"**PS-> CR LF LF " Work - (918) 581-8566"*PS-> WITH NO ADVANCING.*PS->  DISPLAY SET_AUTO_REPEAT_ON. EXIT PROGRAM."* ----------MENU.COB end----------END PROGRAM MENU.IDENTIFICATION DIVISION.PROGRAM-ID. SCREEN_BLANK.ENVIRONMENT DI3VISION.CONFIGURATION SECTION.SOURCE-COMPUTER. VAX-11.OBJECT-COMPUTER. VAX-11.SPECIAL-NAMES.0 SYMBOLIC CHARACTERS BELLS CR ESCAPE LF TAB VOID! ARE 8 14 28 11 10 1.*0* This subprogram is called as an AST procedure.* It clears the screen*DATA DIVISION.WORKING-STORAGE SECTION.01 PASS_FLAG PIC X EXTERNAL.01 CURSOR_HOME_AND_CLEAR. 03 FILLER PIC X VALUE ESCAPE.# 03 FILLER PIC X(5) VALUE "[1;1H". 03 FILLER PIC X VALUE ESCAPE. 03 FILLER PIC XX VALUE "[4J".01 STAT PIC S9(9) COMP.01 IOSB PIC S9(18) COMP.'01 BRK$C_DEVICE PIC S9(9) COMP VALUE 1.PROCEDURE DIVISION.BEGIN.% CALL "SYS$BRKTHRUW" USING BY VALUE 1' BY DESCRIPTOR CURSOR_HOME_AND_CLEAR "SYS$OUTPUT" BY VALUE BRK$C_DEVICE BY REFERENCE IOSB BY VALUE 0 0 0 0 0 0 GIVING STAT.8 IF STAT IS FAILURE CALL 'LIB$STOP' USING BY VALUE STAT. MOVE "Y" TO PASS_FLAG. EXIT PROGRAM.** ----------SCREEN_BLANK.COB end----------END PROGRAM SCREEN_BLANK.5ww뢾珐* UTL011C_MENU.COBIDENTIFICATION DIVISION.PROGRAM-ID. UTL011C_MENU.AUTHOR. WAYNE CLOUD(INSTALLATION. ELECTROSPACE SYSTEMS, INC.DATE-WRITTEN. 03/20/87O********************************************************************************* MENU GENERATOR UTILITY*C* Reads 1-17 records from the command procedure to generate a menu.C* The records are in the format "description^command". Blank linesC* may be inserted. The descriptions are listed on the m6enu, and ifC* selected, the associated command is executed. A DCL password may>* optionally be passed to this program to allow access to DCL.*'* MODULES TO BE LINKED TO THIS PROGRAM:7* UTL011S_MENU - The FMS Menu Form used by this program3* UTL011S_HELP - The FMS Help Form used by the menu*O**********************************************************************************ENDENVIRONMENT DIVISION.CONFIGURATION SECTION.SOURCE-COMPUTER. VAX-CLUSTER.OBJECT-COMPUTER. VAX-CLU7STER.DATA DIVISION.WORKING-STORAGE SECTION.01 FMS-COMMON GLOBAL.! 05 FMS-TCA-NAME PIC X(12).& 05 FMS-TCA-SIZE PIC S9(5) COMP.5 05 FMS-TERMINAL-CHANNEL PIC S9(5) COMP VALUE 1.& 05 FMS-WORKSPACE-LINK PIC X(12).6 05 FMS-WORKSPACE-SIZE PIC S9(5) COMP VALUE 2000.( 05 FMS-TERMINATOR PIC S9(5) COMP.01 WORK-AREA.! 05 DCL-PASSWORD PIC X(20).! 05 DCL-COMMAND PIC X(100)., 05 COMMAND OCCURS 18 TIMES PIC X(100). 05 TITLE PIC X8(40).& 05 TITLE-LENGTH PIC 99 COMP-3.& 05 TITLE-OFFSET PIC 99 COMP-3. 05 OPTION." 10 OPTION-NUMBER PIC Z9.' 10 FILLER PIC XX VALUE ".".$ 10 OPTION-TEXT PIC X(55). 05 MSG1.$ 10 MSG1-RESPONSE PIC X(3). 10 FILLER PIC X(60)I VALUE "is an Invalid Selection - Press [HELP] for Options". 05 DATA-LINE PIC X(100)." 05 LINE-MAX PIC S9(5) COMP.$ 05 LINE-INDEX PIC S9(5) COMP. 05 RESPON9SE PIC XX.O******************************************************************************** O*******************************************************************************PROCEDURE DIVISION.100-MAINLINE SECTION.100-INITIALIZE. INITIALIZE WORK-AREA.< CALL "LIB$GET_FOREIGN" USING BY DESCRIPTOR DCL-PASSWORD. PERFORM 9000-START-FMS.8 CALL "FDV$CDISP" USING BY DESCRIPTOR "UTL011S_MENU".! PERFORM 3000-DISPLAY-HEADING. PERFORM 4000-DISPLAY-LINES.O*-----:------------------------------------------------------------------------- 100-PROCESS./ CALL "FDV$GET" USING BY DESCRIPTOR RESPONSE# BY REFERENCE FMS-TERMINATOR! BY DESCRIPTOR "RESPONSE".3 CALL "FDV$PUTD" USING BY DESCRIPTOR "RESPONSE".# MOVE RESPONSE TO MSG1-RESPONSE. EVALUATE RESPONSE (1:1) WHEN " " WHEN "E"$ WHEN "M" MOVE "EXIT" TO DCL-COMMAND WHEN "O" WHEN "B"& WHEN "L" MOVE "LOGOUT" TO DCL-COMMAND" WHEN "D" PERFORM 6000-PROCESS-DCL' W;HEN OTHER PERFORM 5000-PROCESS-NUMBER END-EVALUATE. IF DCL-COMMAND = SPACES THEN CALL "FDV$SIGOP". CALL "FDV$PUTL" USING BY DESCRIPTOR MSG1 GO TO 100-PROCESS END-IF.O*------------------------------------------------------------------------------100-END-OF-JOB. CALL "FDV$CLEAR". PERFORM 9500-STOP-FMS.: CALL "LIB$DO_COMMAND" USING BY DESCRIPTOR DCL-COMMAND. STOP RUN.O******************************************************************************<* O*******************************************************************************3000-DISPLAY-HEADING SECTION. 3000-ENTRY. ACCEPT DATA-LINE.G INSPECT DATA-LINE TALLYING TITLE-LENGTH FOR CHARACTERS BEFORE " ".7 COMPUTE TITLE-OFFSET = (40 - TITLE-LENGTH) / 2 + 1.G MOVE DATA-LINE(1:TITLE-LENGTH) TO TITLE(TITLE-OFFSET:TITLE-LENGTH)., CALL "FDV$PUT" USING BY DESCRIPTOR TITLE BY DESCRIPTOR "TITLE". 3000-EXIT. EXIT.O**************************************=*****************************************4000-DISPLAY-LINES SECTION. 4000-ENTRY., ACCEPT DATA-LINE AT END GO TO 4000-EXIT. ADD 1 TO LINE-INDEX., IF LINE-INDEX > 17 THEN GO TO 4000-EXIT.0 IF DATA-LINE = SPACES THEN GO TO 4000-ENTRY. ADD 1 TO LINE-MAX.# MOVE LINE-MAX TO OPTION-NUMBER., UNSTRING DATA-LINE DELIMITED BY "^" INTO OPTION-TEXT COMMAND(LINE-MAX).- CALL "FDV$PUT" USING BY DESCRIPTOR OPTION BY DESCRIPTOR "LINE" BY REFERENCE LINE-INDE>X. GO TO 4000-ENTRY. 4000-EXIT. EXIT.O*******************************************************************************5000-PROCESS-NUMBER SECTION. 5000-ENTRY. IF RESPONSE(2:1) = " "+ THEN MOVE RESPONSE (1:1) TO RESPONSE (2:1) MOVE "0" TO RESPONSE (1:1) END-IF.4 IF RESPONSE IS NOT NUMERIC THEN GO TO 5000-EXIT. MOVE RESPONSE TO LINE-INDEX.2 IF LINE-INDEX > LINE-MAX THEN GO TO 5000-EXIT. IF LINE-INDEX = ZERO" THEN MOVE "LOGOUT" TO DCL-COMMAND- ELS?E MOVE COMMAND(LINE-INDEX) TO DCL-COMMAND END-IF. 5000-EXIT. EXIT.O*******************************************************************************6000-PROCESS-DCL SECTION. 6000-ENTRY.2 IF DCL-PASSWORD = SPACES THEN GO TO 6000-EXIT.0 CALL "FDV$GET" USING BY DESCRIPTOR DATA-LINE# BY REFERENCE FMS-TERMINATOR! BY DESCRIPTOR "PASSWORD".@ IF DATA-LINE = DCL-PASSWORD THEN MOVE "STOP" TO DCL-COMMAND. 6000-EXIT. EXIT.O**************************@*****************************************************9000-START-FMS SECTION. 9000-ENTRY.5 CALL "FDV$ATERM" USING BY DESCRIPTOR FMS-TCA-NAME! BY REFERENCE FMS-TCA-SIZE) BY REFERENCE FMS-TERMINAL-CHANNEL! BY DESCRIPTOR "SYS$COMMAND:".? CALL "FDV$AWKSP" USING BY DESCRIPTOR FMS-WORKSPACE-LINK ) BY DESCRIPTOR FMS-WORKSPACE-SIZE. 9000-EXIT. EXIT.O*******************************************************************************9500-STOP-FMS SE CTION. 9500-ENTRY.6 CALL "FDV$DTERM" USING BY DESCRIPTOR FMS-TCA-NAME.< CALL "FDV$DWKSP" USING BY DESCRIPTOR FMS-WORKSPACE-LINK. 9500-EXIT. EXIT.O*******************************************************************************END PROGRAM UTL011C_MENU.ww