home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / cobol / library / assist / abend2.cbl next >
Text File  |  1993-12-08  |  9KB  |  241 lines
  1. 000100$SET ANS85 NOOSVS MF
  2. 000110
  3. 000200 IDENTIFICATION DIVISION.
  4. 000300    PROGRAM-ID. ABEND.
  5. 000400     AUTHOR. GEORGE HARRIS.
  6. 000410
  7. 000500********************** ABEND2.CBL ***********************************
  8. 000510**              copyright 1993 George F. Harris
  9. 000520**
  10. 000600** THIS PROGRAM WILL IDENTIFY FILE STATUS CODE MESSAGES, INCLUDING
  11. 000610** IBM 370/390 AND VAX.
  12. 000620**
  13. 000630** BINARY REDEFINITION OF FILE STATUS NOT SUPPORTED.
  14. 002500********************************************************************
  15. 002600 ENVIRONMENT DIVISION.
  16. 002610 CONFIGURATION SECTION.
  17. 002700**********************
  18. 002800* special names section     CRT Status identifies exact usage of
  19. 002900* -cursor position          a function key and th number of the
  20. 003000* - crt status              key used.
  21. 003100**********************
  22. 003110 SPECIAL-NAMES.
  23. 003120  cursor is cursor-position
  24. 003130  crt status is key-status.
  25. 003140 FILE-CONTROL.
  26. 003160****************************
  27. 003206* FILE STATUS RETURN CODES
  28. 003207****************************
  29. 003208    SELECT STATFILE ASSIGN TO "FSTAT2.DAT"
  30. 003210    ORGANIZATION IS INDEXED
  31. 003220    RECORD KEY IS IND-KEY
  32. 003230    ACCESS IS DYNAMIC
  33. 003240    FILE STATUS IS IND-STATUS.
  34. 003300 DATA DIVISION.
  35. 003310 FILE SECTION.
  36. 003394 FD STATFILE
  37. 003395     DATA RECORD IS IND-REC.
  38. 003396 01 IND-REC.
  39. 003397     05 STAT-DEFINE               PIC X(72).
  40. 003398     05                           PIC X.
  41. 003399     05 IND-KEY                   PIC X(4).
  42. 003401 WORKING-STORAGE SECTION.
  43. 003405*******************
  44. 003406* KEYS
  45. 003407*******************
  46. 003408 01 TEMP-STATUS-KEY.
  47. 003409     05 TEMP-KEY-1               PIC X(2) VALUE SPACES.
  48. 003410     05 TEMP-KEY-2               PIC XX VALUE "00".
  49. 003435 01 WS-STATUS.
  50. 003436     05 FIRST-WS                 PIC X.
  51. 003437     05 SECOND-WS                PIC X.
  52. 003438 01 IND-STATUS.
  53. 003439     05 FST-IND                  PIC X.
  54. 003440     05 SND-IND                  PIC X.
  55. 003441 01 WORK-FILES.
  56. 003470     05 CHAIN-STATUS            PIC X(4) VALUE SPACES.
  57. 003490     05 ERR-MSG-1               PIC X(72) VALUE SPACES.
  58. 003500     05 ERR-MSG-2          PIC X(72) VALUE SPACES.
  59. 003600*************************
  60. 003700* CURSOR POSITION FIELDS      allows positioning of cursor
  61. 003800*************************
  62. 003810 01 cursor-position.
  63. 003820     05 cursor-row         pic 99 value zeros.
  64. 003830     05 cursor-column      pic 99 value zeros.
  65. 003840*********************************************************************
  66. 003850**                       CRT STATUS KEYS
  67. 003860*********************************************************************
  68. 003870************************
  69. 003880* fields used to get a       CALL X"AF" USING get-single-char
  70. 003890* single character with                       key-status
  71. 003891* call x"af" using           Allows a single key from the keyboard
  72. 003892* command                     Holds action until key is pressed
  73. 003893************************
  74. 003894 01 Get-single-char           pic 9(2) comp-x value 26.
  75. 003895 01 key-status.
  76. 003896     05 key-type           pic x.
  77. 003897     05 key-code-1         pic 9(2) comp-x.
  78. 003898     05 key-code-2         pic 9(2) comp-x.
  79. 003899**********************************************************************
  80. 003900** The following fields are used with the call x"af" function to
  81. 003901**  enable or disable various function and user keys
  82. 003902**********************************************************************
  83. 003903************************
  84. 003904* fields used to enable/
  85. 003905* disable adis messages,      CALL X"AF" USING set-bit-pairs
  86. 003906* indicators and displays                      parameter-block
  87. 003907* using call x"af" command
  88. 003908************************
  89. 003909 01 set-bit-pairs           pic 9(2) comp-x value 1.
  90. 003910 01 parameter-block.
  91. 003911     05 bit-pair-setting    pic 9(2) comp-x.
  92. 003912     05 filler              pic x value "2".
  93. 003913     05 bit-pair-number     pic 9(2) comp-x.
  94. 003914     05 filler              pic 9(2) comp-x value 1.
  95. 003915************************
  96. 003916* fields used to enable/
  97. 003917* disable function keys,      CALL X"AF" USING set-bit-pairs-1
  98. 003918* using call x"af" command                     user-key-control
  99. 003919************************
  100. 003920 01 set-bit-pairs-1            pic 9(2) comp-x value 1.
  101. 003921 01 user-key-control.
  102. 003922     05 user-key-setting       pic 9(2) comp-x.
  103. 003923     05 filler                 pic x value "1".
  104. 003924     05 first-user-key         pic 9(2) comp-x.
  105. 003925     05 number-of-keys         pic 9(2) comp-x.
  106. 003926**************************
  107. 003927* changes the key mapping      CALL X"AF' USING set-map-byte
  108. 003928* from within the program                       ADIS-key-mapping
  109. 003929* using call x"af" using
  110. 003930* command
  111. 003931**************************
  112. 003932 01 set-map-byte                  pic 9(2) comp-x.
  113. 003933 01 adis-key-mapping.
  114. 003934     05 adis-mapping-byte         pic 9(2) comp-x.
  115. 003935     05 adis-key-number           pic 9(2) comp-x.
  116. 003936**********************************************************************
  117. 003937**                 SCREEN DISPLAY
  118. 003938**********************************************************************
  119. 003939 SCREEN SECTION.
  120. 003940 01 menu-screen.
  121. 003944     05 line 2 col 27 value "FILE STATUS RETURN CODES".
  122. 003948     05 line 6 col 11 value
  123. 003949     "ENTER FILE STATUS RETURN CODE AND PRESS THE F2 FUNCTION KEY"
  124. 003950-    .
  125. 003951     05 line 8 col 11 value
  126. 003952        "FILE STATUS CODE:" HIGHLIGHT.
  127. 003953     05 line 8 col 30 pic X(2) to TEMP-KEY-1.
  128. 003954     05 line 14 col 2 value "STATUS MESSAGE FOR FILE STATUS".
  129. 003955     05 line 14 col 33 pic X(2) from TEMP-KEY-1 reverse-video.
  130. 003956     05 line 14 col 36 value "IS:".
  131. 003957     05 line 16 col 2 pic x(72) from err-msg-1 highlight.
  132. 003958     05 line 17 col 2 pic x(72) from err-msg-2.
  133. 003965     05 line 24 col 1 value
  134. 003966          "  F1= MAIN HELP            F2= FILE STATUS CODES
  135. 003967-         " F10= RETURN TO DOS".
  136. 003968 01 BLANK-SCREEN.
  137. 003969 PROCEDURE DIVISION.
  138. 003970 000-main.
  139. 003971     MOVE SPACES TO TEMP-KEY-1.
  140. 003972     PERFORM 010-ENABLE.
  141. 003973     PERFORM 100-GET-SCREEN.
  142. 003974 010-ENABLE.
  143. 003975************************
  144. 003976*ENABLES FUNCITON KEYS
  145. 003977*F-1 THROUGH F-10
  146. 003978************************
  147. 003979     MOVE 1 TO USER-KEY-SETTING.
  148. 003980     MOVE 1 TO FIRST-USER-KEY.
  149. 003981     MOVE 10 TO NUMBER-OF-KEYS.
  150. 003982     CALL X"AF" USING SET-BIT-PAIRS-1
  151. 003983                       USER-KEY-CONTROL.
  152. 003984 100-GET-SCREEN.
  153. 003985***********************
  154. 003986* sets color of screen
  155. 003987***********************
  156. 003988 DISPLAY " " AT 0101
  157. 003989      upon CRT
  158. 003990      erase
  159. 003991      with
  160. 003992         foreground-color is 7
  161. 003993         background-color is 1.
  162. 003994*************************
  163. 003995* displays main screen
  164. 003996*************************
  165. 004010     MOVE 8 TO CURSOR-ROW.
  166. 004100     MOVE 35 TO CURSOR-POSITION.
  167. 004301     DISPLAY MENU-SCREEN.
  168. 004311     ACCEPT MENU-SCREEN.
  169. 004330************************
  170. 004340* Sets up function keys
  171. 004350************************
  172. 004360     IF KEY-CODE-1 = 1
  173. 004361        IF ERR-MSG-1 = SPACES
  174. 004362           CHAIN "SOC7.EXE "
  175. 004363              ELSE
  176. 004367     CHAIN "DETAIL1A.EXE " USING CHAIN-STATUS
  177. 004369     ELSE
  178. 004370     IF KEY-CODE-1 = 2
  179. 004373     MOVE SPACES TO ERR-MSG-1
  180. 004380     PERFORM 300-FILE-STATUS
  181. 004390     ELSE
  182. 004391     IF KEY-CODE-1 = 3
  183. 004392     MOVE "INVALID KEY" TO ERR-MSG-1
  184. 004393     PERFORM 100-GET-SCREEN
  185. 004396     ELSE
  186. 004397     IF KEY-CODE-1 = 4
  187. 004398     MOVE "INVALID KEY" TO ERR-MSG-1
  188. 004399     PERFORM 100-GET-SCREEN
  189. 004400     ELSE
  190. 004401     IF KEY-CODE-1 = 5
  191. 004402     MOVE "INVALID KEY" TO ERR-MSG-1
  192. 004403     PERFORM 100-GET-SCREEN
  193. 004404     ELSE
  194. 004405     IF KEY-CODE-1 = 6
  195. 004406     MOVE "INVALID KEY" TO ERR-MSG-1
  196. 004407     PERFORM 100-GET-SCREEN
  197. 004411     ELSE
  198. 004412     IF KEY-CODE-1 = 7
  199. 004413     MOVE "INVALID KEY" TO ERR-MSG-1
  200. 004414     PERFORM 100-GET-SCREEN
  201. 004416     ELSE
  202. 004417     IF KEY-CODE-1 = 8
  203. 004418     MOVE "INVALID KEY" TO ERR-MSG-1
  204. 004419     PERFORM 100-GET-SCREEN
  205. 004421     ELSE
  206. 004422     IF KEY-CODE-1 = 9
  207. 004423     MOVE "INVALID KEY" TO ERR-MSG-1
  208. 004424     PERFORM 100-GET-SCREEN
  209. 004426     ELSE
  210. 004427     IF KEY-CODE-1 = 10
  211. 004428     DISPLAY " " AT 0101
  212. 004429      upon CRT
  213. 004430      erase
  214. 004431      with
  215. 004432         foreground-color is 7
  216. 004433         background-color is 1
  217. 004435     PERFORM 999-ENDER.
  218. 004438 300-FILE-STATUS.
  219. 004439     MOVE TEMP-STATUS-KEY TO CHAIN-STATUS.
  220. 004451     PERFORM 350-STATUS.
  221. 004452 350-STATUS.
  222. 004453     OPEN I-O STATFILE.
  223. 004454     IF IND-STATUS NOT = "00"
  224. 004455     MOVE IND-STATUS TO ERR-MSG-1
  225. 004456     PERFORM 100-GET-SCREEN
  226. 004457     ELSE
  227. 004459     PERFORM 375-READ-IT.
  228. 004460 375-READ-IT.
  229. 004463     MOVE TEMP-STATUS-KEY TO IND-KEY.
  230. 004465     READ STATFILE.
  231. 004466     IF IND-STATUS NOT = "00"
  232. 004467     MOVE "NOT A VALID CODE" TO ERR-MSG-1
  233. 004468     CLOSE STATFILE
  234. 004469     PERFORM 100-GET-SCREEN
  235. 004470     ELSE
  236. 004471     MOVE STAT-DEFINE TO ERR-MSG-1
  237. 004472     CLOSE STATFILE
  238. 004473     PERFORM 100-GET-SCREEN.
  239. 004520 999-ENDER.
  240. 004600     STOP RUN.
  241.