home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / cobol / library / assist / soc7.cbl < prev   
Text File  |  1993-12-08  |  9KB  |  230 lines
  1. 000100$SET ANS85 NOOSVS MF
  2. 000200
  3. 000300 IDENTIFICATION DIVISION.
  4. 000400    PROGRAM-ID. SOC7.
  5. 000500     AUTHOR. GEORGE HARRIS.
  6. 000600
  7. 000700************************** SOC7.CBL ********************************
  8. 000710**              Copyright 1993 George F. Harris
  9. 000720**
  10. 000800** THIS IS A GENERIC HELP SCREEN WHICH GIVES AN OVERVIEW OF THE
  11. 000900** PROGRAM ASSIST.EXE.
  12. 001000**
  13. 001100** THIS PROGRAM IS CALLED IF THE F1 HELP KEY IS USED WHEN THERE IS
  14. 001200** NO FILE STATUS CODE YET CHOSEN.
  15. 001770********************************************************************
  16. 001780 ENVIRONMENT DIVISION.
  17. 001790 CONFIGURATION SECTION.
  18. 001791**********************
  19. 001792* special names section     CRT Status identifies exact usage of
  20. 001793* -cursor position          a function key and th number of the
  21. 001794* - crt status              key used.
  22. 001795**********************
  23. 001796 SPECIAL-NAMES.
  24. 001797  cursor is cursor-position
  25. 001798  crt status is key-status.
  26. 001799 DATA DIVISION.
  27. 001800 WORKING-STORAGE SECTION.
  28. 001801****************************
  29. 001802* messages
  30. 001805****************************
  31. 001806 01 MSG-X                   PIC X(80) VALUE SPACES.
  32. 001811****************************
  33. 001812* key to determine if program
  34. 001813* runs stand-alone or as a
  35. 001814* part of ABEND.EXE
  36. 001815****************************
  37. 001816 01 HELP-ME                  PIC X VALUE "E".
  38. 001817 01 TOPIC-SELECT             PIC 99 VALUE ZEROS.
  39. 001819****************************
  40. 001820* SWITCHES AND COUNTERS
  41. 001821****************************
  42. 001829*************************
  43. 001830* cursor position fields      allows positioning of cursor
  44. 001831*************************
  45. 001832 01 cursor-position.
  46. 001833     05 cursor-row         pic 99 value zeros.
  47. 001834     05 cursor-column      pic 99 value zeros.
  48. 001835*********************************************************************
  49. 001836**                       CRT STATUS KEYS
  50. 001837*********************************************************************
  51. 001838************************
  52. 001839* fields used to get a       CALL X"AF" USING get-single-char
  53. 001840* single character with                       key-status
  54. 001841* call x"af" using           Allows a single key from the keyboard
  55. 001842* command                     Holds action until key is pressed
  56. 001843************************
  57. 001844 01 Get-single-char           pic 9(2) comp-x value 26.
  58. 001845 01 key-status.
  59. 001846     05 key-type           pic x.
  60. 001847     05 key-code-1         pic 9(2) comp-x.
  61. 001848     05 key-code-2         pic 9(2) comp-x.
  62. 001849**********************************************************************
  63. 001850** The following fields are used with the call x"af" function to
  64. 001851**  enable or disable various function and user keys
  65. 001852**********************************************************************
  66. 001853************************
  67. 001854* fields used to enable/
  68. 001855* disable adis messages,      CALL X"AF" USING set-bit-pairs
  69. 001856* indicators and displays                      parameter-block
  70. 001857* using call x"af" command
  71. 001858************************
  72. 001859 01 set-bit-pairs           pic 9(2) comp-x value 1.
  73. 001860 01 parameter-block.
  74. 001861     05 bit-pair-setting    pic 9(2) comp-x.
  75. 001862     05 filler              pic x value "2".
  76. 001863     05 bit-pair-number     pic 9(2) comp-x.
  77. 001864     05 filler              pic 9(2) comp-x value 1.
  78. 001865************************
  79. 001866* fields used to enable/
  80. 001867* disable function keys,      CALL X"AF" USING set-bit-pairs-1
  81. 001868* using call x"af" command                     user-key-control
  82. 001869************************
  83. 001870 01 set-bit-pairs-1            pic 9(2) comp-x value 1.
  84. 001871 01 user-key-control.
  85. 001872     05 user-key-setting       pic 9(2) comp-x.
  86. 001873     05 filler                 pic x value "1".
  87. 001874     05 first-user-key         pic 9(2) comp-x.
  88. 001875     05 number-of-keys         pic 9(2) comp-x.
  89. 001876**************************
  90. 001877* changes the key mapping      CALL X"AF' USING set-map-byte
  91. 001878* from within the program                       ADIS-key-mapping
  92. 001879* using call x"af" using
  93. 001880* command
  94. 001881**************************
  95. 001882 01 set-map-byte                  pic 9(2) comp-x.
  96. 001883 01 adis-key-mapping.
  97. 001884     05 adis-mapping-byte         pic 9(2) comp-x.
  98. 001885     05 adis-key-number           pic 9(2) comp-x.
  99. 001886**********************************************************************
  100. 001887**                 SCREEN DISPLAY
  101. 001888**********************************************************************
  102. 001889 SCREEN SECTION.
  103. 001890 01 GENERAL-HELP-SCREEN.
  104. 001891     05 background-color 1 foreground-color 4.
  105. 001892     05 blank screen.
  106. 001893     05 line 1 col 29 value "WHAT ASSIST.EXE DOES".
  107. 001897     05 line 3 col 1 value
  108. 001898     "ASSIST.EXE allows you to get a simple description of File Re
  109. 001899-    "turn  Codes,  or to ".
  110. 001900     05 line 4 col 1 value
  111. 001901     "see a more detailed explanation by choosing the proper  FUNC
  112. 001902-    "TION KEY.           ".
  113. 001903     05 line 6 col 1 value
  114. 001904     "When ASSIST.EXE comes onto your screen,  enter the two digit
  115. 001905-    " FILE STATUS CODE at".
  116. 001906     05 line 7 col 1 value
  117. 001907     "the prompt and choose  FUNCTION KEY F2.  A one line explanat
  118. 001908-    "ion  of the  meaning".
  119. 001909     05 line 8 col 1 value
  120. 001910     "of that File Status Code will appear on the screen.        "
  121. 001911-     .
  122. 001912     05 line 10 col 1 value
  123. 001913     "If you wish to see a more extensive explanation,  choose FUN
  124. 001914-    "TION KEY F1 and  you".
  125. 001918     05 line 11 col 1 value
  126. 001919     "will see more detail as to the meaning of the File Status Co
  127. 001920-    "de you have chosen. ".
  128. 001921     05 line 13 col 1 value
  129. 001922     "The  File Status Codes  supported in this program are standa
  130. 001923-    "rd two  digit codes.".
  131. 001924     05 line 14 col 1 value
  132. 001925     "VAX and IBM COBOL II codes are also supported, although, thi
  133. 001926-    "s  program does  not".
  134. 001929     05 line 15 col 1 value
  135. 001930     "at this time support a BINARY redefinition of the File Statu
  136. 001931-    "s Code, or the three".
  137. 001932     05 line 16 col 1 value
  138. 001933     "level definition (RETURN/FUNCTION/FEEDBACK CODES) which are
  139. 001934-    "available  for  VSAM".
  140. 001935     05 line 17 col 1 value
  141. 001936     "files on an IBM 370/390 System.                           ".
  142. 001958     05 LINE 24 COL 1 PIC X(80) FROM MSG-X highlight.
  143. 001960     05 line 25 col 1 value
  144. 001961     "            F1 MAIN MENU                   F10 QUIT TO DOS".
  145. 001965 01 BLANK-SCREEN.
  146. 001966     05 background-color 1 foreground-color 4.
  147. 001967     05 blank screen.
  148. 001980 PROCEDURE DIVISION.
  149. 001981     PERFORM 010-ENABLE.
  150. 001982     PERFORM 100-GET-SCREEN.
  151. 001983 010-ENABLE.
  152. 001984************************
  153. 001985*ENABLES FUNCITON KEYS
  154. 001986*F-1 THROUGH F-10
  155. 001987************************
  156. 001988     MOVE 1 TO USER-KEY-SETTING.
  157. 001989     MOVE 1 TO FIRST-USER-KEY.
  158. 001990     MOVE 10 TO NUMBER-OF-KEYS.
  159. 001992     CALL X"AF" USING SET-BIT-PAIRS-1
  160. 001993                       USER-KEY-CONTROL.
  161. 001994
  162. 001995 100-GET-SCREEN.
  163. 001996***********************
  164. 001997* sets color of screen
  165. 001998***********************
  166. 001999 DISPLAY " " AT 0101
  167. 002000      upon CRT
  168. 002001      erase
  169. 002002      with
  170. 002003         foreground-color is 7
  171. 002004         background-color is 1.
  172. 002005***********************
  173. 002006* gets main screen
  174. 002007***********************
  175. 002008     MOVE 1 TO CURSOR-ROW.
  176. 002009     MOVE 1 TO CURSOR-POSITION.
  177. 002010     DISPLAY GENERAL-HELP-SCREEN.
  178. 002011**********************
  179. 002012* holds action until a
  180. 002013* keystroke
  181. 002014**********************
  182. 002015     CALL X"AF" USING GET-SINGLE-CHAR
  183. 002016                      KEY-STATUS.
  184. 002017************************
  185. 002018* Sets up function keys
  186. 002019************************
  187. 002020     IF KEY-CODE-1 = 1
  188. 002021     PERFORM 200-GOBACK
  189. 002022     ELSE
  190. 002023     IF KEY-CODE-1 = 2
  191. 002024     MOVE "INVALID KEY" TO MSG-X
  192. 002025     PERFORM 100-GET-SCREEN
  193. 002026     ELSE
  194. 002027     IF KEY-CODE-1 = 3
  195. 002028     MOVE "INVALID KEY" TO MSG-X
  196. 002029     PERFORM 100-GET-SCREEN
  197. 002030     ELSE
  198. 002031     IF KEY-CODE-1 = 4
  199. 002032     MOVE "INVALID KEY" TO MSG-X
  200. 002033     PERFORM 100-GET-SCREEN
  201. 002034     ELSE
  202. 002035     IF KEY-CODE-1 = 5
  203. 002036     MOVE "INVALID KEY" TO MSG-X
  204. 002037     PERFORM 100-GET-SCREEN
  205. 002038     ELSE
  206. 002039     IF KEY-CODE-1 = 6
  207. 002040     MOVE "INVALID KEY" TO MSG-X
  208. 002041     PERFORM 100-GET-SCREEN
  209. 002042     ELSE
  210. 002043     IF KEY-CODE-1 = 7
  211. 002044     MOVE "INVALID KEY" TO MSG-X
  212. 002045     PERFORM 100-GET-SCREEN
  213. 002046     ELSE
  214. 002047     IF KEY-CODE-1 = 8
  215. 002048     MOVE "INVALID KEY" TO MSG-X
  216. 002049     PERFORM 100-GET-SCREEN
  217. 002050     ELSE
  218. 002051     IF KEY-CODE-1 = 9
  219. 002052     MOVE "INVALID KEY" TO MSG-X
  220. 002053     PERFORM 100-GET-SCREEN
  221. 002054     ELSE
  222. 002062     IF KEY-CODE-1 = 10
  223. 002063     DISPLAY BLANK-SCREEN
  224. 002064     PERFORM 999-ENDER.
  225. 002083 200-GOBACK.
  226. 002084     CHAIN "ABEND2.EXE".
  227. 002210 999-ENDER.
  228. 002300     DISPLAY BLANK-SCREEN.
  229. 002400     STOP RUN.
  230.