home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / cobol / library / assist / detail1a.cbl < prev    next >
Text File  |  1993-12-08  |  13KB  |  303 lines
  1. 000010$set ans85 mf noosvs acceptrefresh
  2. 000020
  3. 000030 IDENTIFICATION DIVISION.
  4. 000040 PROGRAM-ID. DETAIL1.
  5. 000100********************** DETAIL1.CBL **********************************
  6. 000200**         Copyright 1993 George F. Harris
  7. 000210**
  8. 000300** THIS PROGRAM PRESENTS DETAIL INFORMATION FOR BASIC FILE STATUS
  9. 000400*  RETURN CODES USING THE FSDETAIL FILE.
  10. 000700*********************************************************************
  11. 000800 ENVIRONMENT DIVISION.
  12. 000900 CONFIGURATION SECTION.
  13. 001000**********************
  14. 001100* special names section     CRT Status identifies exact usage of
  15. 001200* -cursor position          a function key and th number of the
  16. 001300* - crt status              key used.
  17. 001400**********************
  18. 001410 SPECIAL-NAMES.
  19. 001420  cursor is cursor-position
  20. 001430  crt status is key-status.
  21. 001431 FILE-CONTROL.
  22. 001442****************************
  23. 001443* INDEX FILE FOR BASIC
  24. 001444* STATUS CODES.
  25. 001445****************************
  26. 001446    SELECT DATAFILE ASSIGN TO  "FSTAT2.DAT"
  27. 001447    ORGANIZATION IS INDEXED
  28. 001448    RECORD KEY IS FS-KEY
  29. 001449    ACCESS IS DYNAMIC
  30. 001450    FILE STATUS IS WS-STATUS.
  31. 001451 DATA DIVISION.
  32. 001452 FILE SECTION.
  33. 001453 FD DATAFILE
  34. 001454     DATA RECORD IS DATA-REC.
  35. 001455 01 DATA-REC.
  36. 001456     05 DETAILS                   PIC X(72) VALUE SPACES.
  37. 001457     05                           pic x value spaces.
  38. 001458     05 FS-KEY                   PIC X(4).
  39. 001465 WORKING-STORAGE SECTION.
  40. 001468*01 TEMP-KEY                      PIC 9999 VALUE ZEROS.
  41. 001469*01 XS-TEMP-KEY                   PIC 9(5) VALUE ZEROS.
  42. 001470*01 TEMP-DETAILS.
  43. 001471*    05 TEMP-DETAIL               PIC X(72) VALUE SPACES.
  44. 001472*    05                           PIC X VALUE SPACES.
  45. 001473*    05 DETAIL-KEY                PIC 9(4) VALUE ZEROS.
  46. 001474*01 R-KEY                         PIC 999 COMP.
  47. 001475*01 XS-STATUS-KEY                 PIC 9(5) VALUE ZEROS.
  48. 001477 01 WS-STATUS.
  49. 001478     05 FRST-STATUS              PIC X.
  50. 001479     05 SEC-STATUS             PIC X.
  51. 001480*01 XS-STATUS.
  52. 001481*    05 XS-STATUS-1              PIC X.
  53. 001482*    05 XS-SATATUS-2           PIC X.
  54. 001483 01 ERR-MSG-1                     PIC X(15) VALUE SPACES.
  55. 001484 01 DETAIL-LINES.
  56. 001485     05 DETAIL-1                  PIC X(72) VALUE SPACES.
  57. 001486     05 DETAIL-2                  PIC X(72) VALUE SPACES.
  58. 001487     05 DETAIL-3                  PIC X(72) VALUE SPACES.
  59. 001488     05 DETAIL-4                  PIC X(72) VALUE SPACES.
  60. 001489     05 DETAIL-5                  PIC X(72) VALUE SPACES.
  61. 001490     05 DETAIL-6                  PIC X(72) VALUE SPACES.
  62. 001491     05 DETAIL-7                  PIC X(72) VALUE SPACES.
  63. 001492     05 DETAIL-8                  PIC X(72) VALUE SPACES.
  64. 001493     05 DETAIL-9                  PIC X(72) VALUE SPACES.
  65. 001494     05 DETAIL-10                 PIC X(72) VALUE SPACES.
  66. 001495     05 DETAIL-11                 PIC X(72) VALUE SPACES.
  67. 001496     05 DETAIL-12                 PIC X(72) VALUE SPACES.
  68. 001497     05 DETAIL-13                 PIC X(72) VALUE SPACES.
  69. 001498     05 DETAIL-14                 PIC X(72) VALUE SPACES.
  70. 001499     05 DETAIL-15                 PIC X(72) VALUE SPACES.
  71. 001500     05 DETAIL-16                 PIC X(72) VALUE SPACES.
  72. 001501     05 DETAIL-17                 PIC X(72) VALUE SPACES.
  73. 001502     05 DETAIL-18                 PIC X(72) VALUE SPACES.
  74. 001503     05 DETAIL-19                 PIC X(72) VALUE SPACES.
  75. 001504     05 DETAIL-20                 PIC X(72) VALUE SPACES.
  76. 001505 01 CHAIN-STATUS                  PIC X(4) VALUE SPACES.
  77. 001506 01 ERR-CD REDEFINES CHAIN-STATUS.
  78. 001507     05 CHAIN-1                   PIC XX.
  79. 001508     05 CHAIN-2                   PIC XX.
  80. 001510*************************
  81. 001511* cursor position fields      allows positioning of cursor
  82. 001512*************************
  83. 001513 01 cursor-position.
  84. 001514     05 cursor-row         pic 99 value zeros.
  85. 001520     05 cursor-column      pic 99 value zeros.
  86. 001600*********************************************************************
  87. 001700**                       CRT STATUS KEYS
  88. 001800*********************************************************************
  89. 001900************************
  90. 002000* fields used to get a       CALL X"AF" USING get-single-char
  91. 002100* single character with                       key-status
  92. 002200* call x"af" using           Allows a single key from the keyboard
  93. 002300* command                     Holds action until key is pressed
  94. 002400************************
  95. 002500 01 Get-single-char           pic 9(2) comp-x value 26.
  96. 002600 01 key-status.
  97. 002700     05 key-type           pic x.
  98. 002800     05 key-code-1         pic 9(2) comp-x.
  99. 002900     05 key-code-2         pic 9(2) comp-x.
  100. 003000**********************************************************************
  101. 003100** The following fields are used with the call x"af" function to
  102. 003200**  enable or disable various function and user keys
  103. 003300**********************************************************************
  104. 003400************************
  105. 003500* fields used to enable/
  106. 003600* disable adis messages,      CALL X"AF" USING set-bit-pairs
  107. 003700* indicators and displays                      parameter-block
  108. 003800* using call x"af" command
  109. 003900************************
  110. 004000 01 set-bit-pairs           pic 9(2) comp-x value 1.
  111. 004100 01 parameter-block.
  112. 004200     05 bit-pair-setting    pic 9(2) comp-x.
  113. 004300     05 filler              pic x value "2".
  114. 004400     05 bit-pair-number     pic 9(2) comp-x.
  115. 004500     05 filler              pic 9(2) comp-x value 1.
  116. 004600************************
  117. 004700* fields used to enable/
  118. 004800* disable function keys,      CALL X"AF" USING set-bit-pairs-1
  119. 004900* using call x"af" command                     user-key-control
  120. 005000************************
  121. 005100 01 set-bit-pairs-1            pic 9(2) comp-x value 1.
  122. 005200 01 user-key-control.
  123. 005300     05 user-key-setting       pic 9(2) comp-x.
  124. 005400     05 filler                 pic x value "1".
  125. 005500     05 first-user-key         pic 9(2) comp-x.
  126. 005600     05 number-of-keys         pic 9(2) comp-x.
  127. 005700**************************
  128. 005800* changes the key mapping      CALL X"AF' USING set-map-byte
  129. 005900* from within the program                       ADIS-key-mapping
  130. 006000* using call x"af" using
  131. 006100* command
  132. 006200**************************
  133. 006300 01 set-map-byte                  pic 9(2) comp-x.
  134. 006400 01 adis-key-mapping.
  135. 006500     05 adis-mapping-byte         pic 9(2) comp-x.
  136. 006600     05 adis-key-number           pic 9(2) comp-x.
  137. 006700**********************************************************************
  138. 006800**                 SCREEN DISPLAY
  139. 006900**********************************************************************
  140. 007000 SCREEN SECTION.
  141. 007100 01 STATUS-SCREEN auto.
  142. 007110     05 LINE 2 COL 23 VALUE
  143. 007111        "THE STATUS CODE IN QUESTION IS" HIGHLIGHT.
  144. 007120     05 LINE 2 COL 54 PIC X(2) FROM CHAIN-1 HIGHLIGHT.
  145. 007200     05 LINE 4 COL 5 PIC X(72) FROM DETAIL-1.
  146. 007300     05 LINE 5 COL 5 PIC X(72) FROM DETAIL-2.
  147. 007400     05 LINE 6 COL 5 PIC X(72) FROM DETAIL-3.
  148. 007500     05 LINE 7 COL 5 PIC X(72) FROM DETAIL-4.
  149. 007600     05 LINE 8 COL 5 PIC X(72) FROM DETAIL-5.
  150. 007700     05 LINE 9 COL 5 PIC X(72) FROM DETAIL-6.
  151. 007800     05 LINE 10 COL 5 PIC X(72) FROM DETAIL-7.
  152. 007900     05 LINE 11 COL 5 PIC X(72) FROM DETAIL-8.
  153. 008000     05 LINE 12 COL 5 PIC X(72) FROM DETAIL-9.
  154. 008100     05 LINE 13 COL 5 PIC X(72) FROM DETAIL-10.
  155. 008200     05 LINE 14 COL 5 PIC X(72) FROM DETAIL-11.
  156. 008300     05 LINE 15 COL 5 PIC X(72) FROM DETAIL-12.
  157. 008400     05 LINE 16 COL 5 PIC X(72) FROM DETAIL-13.
  158. 008500     05 LINE 17 COL 5 PIC X(72) FROM DETAIL-14.
  159. 008600     05 LINE 18 COL 5 PIC X(72) FROM DETAIL-15.
  160. 008700     05 LINE 19 COL 5 PIC X(72) FROM DETAIL-16.
  161. 008800     05 LINE 20 COL 5 PIC X(72) FROM DETAIL-17.
  162. 008900     05 LINE 21 COL 5 PIC X(72) FROM DETAIL-18.
  163. 009000     05 LINE 22 COL 5 PIC X(72) FROM DETAIL-19.
  164. 009100     05 LINE 23 COL 5 PIC X(72) FROM DETAIL-20.
  165. 009110     05 LINE 25 COL 1 PIC X(15) FROM ERR-MSG-1 HIGHLIGHT.
  166. 009200     05 LINE 25 COL 20 VALUE "PRESS F1 TO RETURN" highlight.
  167. 009201     05 LINE 25 COL 50 VALUE "PRESS F10 TO QUIT" highlight.
  168. 009300 PROCEDURE DIVISION CHAINING CHAIN-STATUS.
  169. 009400 000-MAIN.
  170. 009410     PERFORM 050-OPEN.
  171. 009420     PERFORM 100-BASIC-STATUS.
  172. 009430     PERFORM 010-ENABLE.
  173. 009440     PERFORM 300-DISPLAY.
  174. 009510 050-OPEN.
  175. 009513     MOVE SPACES TO DETAIL-LINES.
  176. 009520     OPEN I-O DATAFILE.
  177. 009627 100-BASIC-STATUS.
  178. 009644     MOVE SPACES TO DETAIL-LINES.
  179. 009647     MOVE CHAIN-STATUS TO FS-KEY.
  180. 009649     START DATAFILE.
  181. 009650     READ DATAFILE.
  182. 009655     READ DATAFILE NEXT RECORD
  183. 009656     MOVE DETAILS TO DETAIL-1.
  184. 009660     READ DATAFILE NEXT RECORD
  185. 009700     MOVE DETAILS TO DETAIL-2.
  186. 009900     READ DATAFILE NEXT RECORD
  187. 010000     MOVE DETAILS TO DETAIL-3.
  188. 010200     READ DATAFILE NEXT RECORD
  189. 010300     MOVE DETAILS TO DETAIL-4 .
  190. 010500     READ DATAFILE NEXT RECORD
  191. 010600     MOVE DETAILS TO DETAIL-5.
  192. 010620     READ DATAFILE NEXT RECORD
  193. 010630     MOVE DETAILS TO DETAIL-6.
  194. 010650     READ DATAFILE NEXT RECORD
  195. 010660     MOVE DETAILS TO DETAIL-7.
  196. 010680     READ DATAFILE NEXT RECORD
  197. 010690     MOVE DETAILS TO DETAIL-8.
  198. 010692     READ DATAFILE NEXT RECORD
  199. 010693     MOVE DETAILS TO DETAIL-9.
  200. 010695     READ DATAFILE NEXT RECORD
  201. 010696     MOVE DETAILS TO DETAIL-10.
  202. 010699     READ DATAFILE NEXT RECORD
  203. 010700     MOVE DETAILS TO DETAIL-11.
  204. 010703     READ DATAFILE NEXT RECORD
  205. 010704     MOVE DETAILS TO DETAIL-12.
  206. 010707     READ DATAFILE NEXT RECORD
  207. 010708     MOVE DETAILS TO DETAIL-13.
  208. 010711     READ DATAFILE NEXT RECORD
  209. 010712     MOVE DETAILS TO DETAIL-14.
  210. 010715     READ DATAFILE NEXT RECORD
  211. 010716     MOVE DETAILS TO DETAIL-15.
  212. 010719     READ DATAFILE NEXT RECORD
  213. 010720     MOVE DETAILS TO DETAIL-16.
  214. 010723     READ DATAFILE NEXT RECORD
  215. 010724     MOVE DETAILS TO DETAIL-17.
  216. 010727     READ DATAFILE NEXT RECORD
  217. 010728     MOVE DETAILS TO DETAIL-18.
  218. 010731     READ DATAFILE NEXT RECORD
  219. 010732     MOVE DETAILS TO DETAIL-19.
  220. 010735     READ DATAFILE NEXT RECORD
  221. 010736     MOVE DETAILS TO DETAIL-20.
  222. 010799 010-ENABLE.
  223. 010800************************
  224. 010801*ENABLES FUNCITON KEY
  225. 010802*F-5
  226. 010803************************
  227. 010804     MOVE 1 TO USER-KEY-SETTING.
  228. 010805     MOVE 1 TO FIRST-USER-KEY.
  229. 010806     MOVE 10 TO NUMBER-OF-KEYS.
  230. 010807     CALL X"AF" USING SET-BIT-PAIRS-1
  231. 010808                       USER-KEY-CONTROL.
  232. 010809 300-DISPLAY.
  233. 010810***********************
  234. 010811* sets color of screen
  235. 010812***********************
  236. 010813 DISPLAY " " AT 0101
  237. 010814      upon CRT
  238. 010815      erase
  239. 010816      with
  240. 010817         foreground-color is 7
  241. 010818         background-color is 1.
  242. 010819*************************
  243. 010820* displays main screen
  244. 010821*************************
  245. 010822     MOVE 1 TO CURSOR-ROW.
  246. 010823     MOVE 1 TO CURSOR-POSITION.
  247. 010826     DISPLAY STATUS-SCREEN.
  248. 010827**********************
  249. 010828* holds action until a
  250. 010829* keystroke
  251. 010830**********************
  252. 010831     CALL X"AF" USING GET-SINGLE-CHAR
  253. 010832                      KEY-STATUS.
  254. 010833************************
  255. 010834* Sets up function keys
  256. 010835************************
  257. 010836     IF KEY-CODE-1 = 1
  258. 010837     CHAIN  "ABEND2.EXE "
  259. 010841     ELSE
  260. 010842     IF KEY-CODE-1 = 2
  261. 010843     MOVE "NOT A VALID KEY" TO ERR-MSG-1
  262. 010844     PERFORM 300-DISPLAY
  263. 010845     ELSE
  264. 010846     IF KEY-CODE-1 = 3
  265. 010847     MOVE "NOT A VALID KEY" TO ERR-MSG-1
  266. 010848     PERFORM 300-DISPLAY
  267. 010849     ELSE
  268. 010850     IF KEY-CODE-1 = 4
  269. 010851     MOVE "NOT A VALID KEY" TO ERR-MSG-1
  270. 010852     PERFORM 300-DISPLAY
  271. 010853     ELSE
  272. 010854     IF KEY-CODE-1 = 5
  273. 010855     MOVE "NOT A VALID KEY" TO ERR-MSG-1
  274. 010856     PERFORM 300-DISPLAY
  275. 010859     ELSE
  276. 010860     IF KEY-CODE-1 = 6
  277. 010861     MOVE "NOT A VALID KEY" TO ERR-MSG-1
  278. 010862     PERFORM 300-DISPLAY
  279. 010863     ELSE
  280. 010864     IF KEY-CODE-1 = 7
  281. 010865     MOVE "NOT A VALID KEY" TO ERR-MSG-1
  282. 010866     PERFORM 300-DISPLAY
  283. 010867     ELSE
  284. 010868     IF KEY-CODE-1 = 8
  285. 010869     MOVE "NOT A VALID KEY" TO ERR-MSG-1
  286. 010870     PERFORM 300-DISPLAY
  287. 010871     ELSE
  288. 010872     IF KEY-CODE-1 = 9
  289. 010873     MOVE "NOT A VALID KEY" TO ERR-MSG-1
  290. 010874     PERFORM 300-DISPLAY
  291. 010875     ELSE
  292. 010876     IF KEY-CODE-1 = 10
  293. 010877     DISPLAY " " AT 0101
  294. 010878      upon CRT
  295. 010879      erase
  296. 010880      with
  297. 010881         foreground-color is 7
  298. 010882         background-color is 1
  299. 010883     PERFORM 999-ENDER.
  300. 010884 999-ENDER.
  301. 010890     CLOSE DATAFILE.
  302. 010900     STOP RUN.
  303.