├── CHANGELOG.md ├── LICENSE.md ├── README.md ├── export_options.gif ├── generate_flow.gif ├── highlighting_code.gif ├── sample ├── SLICKP0.cbl ├── SLICKP1.cbl ├── SLICKP2.cbl ├── SLICKP3.cbl ├── SLICKP4.cbl └── SLICKP5.cbl └── tooltip.gif /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # COBOL Control Flow Changelog 2 | 3 | All notable changes to the COBOL Control Flow extension are documented in this file. 4 | 5 | ## [1.2.1] - 2025-04-07 6 | - Support for the new COBOL LS API 7 | - Bug fixes 8 | 9 | ## [1.2.0] - 2025-03-21 10 | - New UI design, top-to-bottom orientation 11 | - Toolbar for easy access 12 | - Dark/Light color schema support 13 | - Styling edges on hover for better tracking 14 | - 'COBOL Control Flow:' command palette prefix 15 | - DOT/JSON export options 16 | - Improved code snippet accuracy 17 | - Bug fixes 18 | - Readme update 19 | 20 | ## [1.1.1] - 2025-02-28 21 | - Support for 'SQL WHENEVER' 22 | - Support for 'CICS HANDLE ABEND' 23 | - Support for 'INLINE PERFORM' 24 | - Support for 'PERFORM' with 'UNTIL' phrase 25 | - Support for 'EXIT PERFORM' 26 | - Support for 'CICS RETURN' 27 | - Fall-thru diagnostic 28 | - Performance improvements 29 | - Bug fixes 30 | - Readme update 31 | 32 | ## [1.1.0] - 2024-04-04 33 | - Support for 'XML PARSE' 34 | - Support for 'SORT' 35 | - Support for 'MERGE' 36 | - Support for 'ALTER' 37 | - Support for 'EXEC CICS RETURN' 38 | - Bug fixes 39 | 40 | ## [1.0.8] - 2024-01-22 41 | - Bug fixes 42 | 43 | ## [1.0.7] - 2024-01-15 44 | - Bug fixes 45 | - Readme update 46 | 47 | ## [1.0.6] - 2024-01-04 48 | - Support for 'GOBACK' statement 49 | - Support for 'EXIT PARAGRAPH' statement 50 | - Support for 'PERFORM THRU' statement 51 | - Bug fixes 52 | 53 | ## [1.0.5] - 2023-03-09 54 | - EXIT SECTION statement fix and SECTION search update in engine 55 | - Bug fixes 56 | 57 | ## [1.0.4] - 2022-11-16 58 | - Remove graph generation menu for copybooks. 59 | - Fix graph for EXEC CICS RETURN statement. 60 | - Fix graph for AT END read file statement. 61 | 62 | ## [1.0.3] - 2022-10-18 63 | - COBOL Language Support or a similar COBOL extension is now required to detect COBOL files. 64 | - Bug fixes 65 | - Readme update 66 | 67 | ## [1.0.2] - 2022-06-29 68 | - New error and warning messages 69 | - Bug fixes 70 | - Readme update 71 | 72 | ## [1.0.1] - 2022-05-06 73 | - Fix missing paragraphs on the graph 74 | 75 | ## [1.0.0] - 2022-04-21 76 | - Increase accuracy of the graph 77 | 78 | ## [0.4.1] - 2022-02-15 79 | - Modified error and warning messages 80 | - Bug fixes 81 | - Readme update 82 | 83 | ## [0.4.0] - 2021-06-08 84 | 85 | - Copybook support 86 | 87 | ## [0.3.3] - 2021-04-06 88 | 89 | - New control flow graph analysis logic 90 | - Unreachable paragraphs and sections no longer shown on the graph 91 | 92 | ## [0.2.0] 93 | 94 | - Code to node highlight added with selected node being centralized in the graph 95 | - Buttons added to expand the entire graph or collapse nodes which are not in the selected path 96 | 97 | ## [0.1.1] 98 | 99 | - Modified error and warning messages 100 | - Added error log file in the extension's folder 101 | 102 | ## [0.1.0] 103 | 104 | - Initial release 105 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | LICENSE AND DISCLAIMER 2 | Copyright © 2020 Broadcom. All rights reserved. The term “Broadcom” refers to Broadcom Inc. and/or its subsidiaries. THESE MATERIALS CONSTITUTE CONFIDENTIAL AND PROPRIETARY INFORMATION BELONGING TO CA, INC., A BROADCOM COMPANY AND SHOULD NOT BE DISTRIBUTED TO ANY OTHER PARTY WITHOUT CA’S PRIOR WRITTEN CONSENT. All authorized reproductions must be marked with this language. 3 | These materials are comprised of plugins for Visual Studio Code. Such materials do not constitute licensed products or software under any other CA license or services agreement. These materials have not been tested for every contingency. CA does not make, and you may not rely on, any promise, express or implied, of reliability, serviceability or function of the materials. 4 | You agree not to, nor to permit anyone else to: (i) cause or permit de-compilation, reverse engineering, or otherwise translate all or any portion of the software; (ii) modify or create derivative works of the software and/or documentation; (iii) rent, sell, lease, assign, transfer or sublicense the software or use the software to provide hosting, service bureau, on demand or outsourcing services for the benefit of a third party; (iv) remove any proprietary notices, labels, or marks on or in any copy or version of the software or documentation. All rights in and to the software described herein, not expressly granted to you, are expressly reserved by CA. 5 | To the extent any open source materials are included, such open source materials are licensed to you under their applicable license terms and conditions and/or copyright notices found in those respective files. 6 | To the extent permitted by applicable law, CA provides these materials “AS IS” without warranty of any kind, including, without limitation, any implied warranties of merchantability, fitness for a particular purpose, or non-infringement. In no event will CA be liable for any loss or damage, direct or indirect, arising from or related to the use of these materials, including, without limitation, lost profits, lost investment, business interruption, goodwill or lost data, even if CA is expressly advised in advance of the possibility of such damages. 7 | The COBOL Control Flow includes the following separately-licensed, third-party components: 8 | 9 | antlr4ts 10 | Copyright (c) 2016 The ANTLR Project 11 | 12 | Redistribution and use in source and binary forms, with or without 13 | modification, are permitted provided that the following conditions 14 | are met: 15 | 16 | 1. Redistributions of source code must retain the above copyright 17 | notice, this list of conditions and the following disclaimer. 18 | 2. Redistributions in binary form must reproduce the above copyright 19 | notice, this list of conditions and the following disclaimer in the 20 | documentation and/or other materials provided with the distribution. 21 | 3. Neither the name of the copyright holder nor the names of its contributors 22 | may be used to endorse or promote products derived from this software 23 | without specific prior written permission. 24 | 25 | THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR 26 | IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 27 | OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 28 | IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 29 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 30 | NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 31 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 32 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 33 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 34 | THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 35 | 36 | ===== 37 | 38 | MIT License for codepointat.js from https://git.io/codepointat 39 | MIT License for fromcodepoint.js from https://git.io/vDW1m 40 | 41 | Copyright Mathias Bynens 42 | 43 | Permission is hereby granted, free of charge, to any person obtaining 44 | a copy of this software and associated documentation files (the 45 | "Software"), to deal in the Software without restriction, including 46 | without limitation the rights to use, copy, modify, merge, publish, 47 | distribute, sublicense, and/or sell copies of the Software, and to 48 | permit persons to whom the Software is furnished to do so, subject to 49 | the following conditions: 50 | 51 | The above copyright notice and this permission notice shall be 52 | included in all copies or substantial portions of the Software. 53 | 54 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 55 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 56 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 57 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 58 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 59 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 60 | WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 61 | 62 | 63 | Codemirror 64 | 65 | MIT License 66 | 67 | Copyright (C) 2017 by Marijn Haverbeke and others 68 | 69 | Permission is hereby granted, free of charge, to any person obtaining a copy 70 | of this software and associated documentation files (the "Software"), to deal 71 | in the Software without restriction, including without limitation the rights 72 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 73 | copies of the Software, and to permit persons to whom the Software is 74 | furnished to do so, subject to the following conditions: 75 | 76 | The above copyright notice and this permission notice shall be included in 77 | all copies or substantial portions of the Software. 78 | 79 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 80 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 81 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 82 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 83 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 84 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 85 | THE SOFTWARE. 86 | 87 | 88 | 89 | 90 | 91 | 92 | d3 93 | 94 | Copyright 2010-2017 Mike Bostock 95 | All rights reserved. 96 | 97 | Redistribution and use in source and binary forms, with or without modification, 98 | are permitted provided that the following conditions are met: 99 | 100 | * Redistributions of source code must retain the above copyright notice, this 101 | list of conditions and the following disclaimer. 102 | 103 | * Redistributions in binary form must reproduce the above copyright notice, 104 | this list of conditions and the following disclaimer in the documentation 105 | and/or other materials provided with the distribution. 106 | 107 | * Neither the name of the author nor the names of contributors may be used to 108 | endorse or promote products derived from this software without specific prior 109 | written permission. 110 | 111 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 112 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 113 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 114 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 115 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 116 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 117 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 118 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 119 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 120 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 121 | 122 | 123 | 124 | 125 | jquery 126 | Copyright JS Foundation and other contributors, https://js.foundation/ 127 | 128 | This software consists of voluntary contributions made by many 129 | individuals. For exact contribution history, see the revision history 130 | available at https://github.com/jquery/jquery 131 | 132 | The following license applies to all parts of this software except as 133 | documented below: 134 | 135 | ==== 136 | 137 | Permission is hereby granted, free of charge, to any person obtaining 138 | a copy of this software and associated documentation files (the 139 | &amp;amp;amp;amp;quot;Software&amp;amp;amp;amp;quot;), to deal in the Software without restriction, including 140 | without limitation the rights to use, copy, modify, merge, publish, 141 | distribute, sublicense, and/or sell copies of the Software, and to 142 | permit persons to whom the Software is furnished to do so, subject to 143 | the following conditions: 144 | 145 | The above copyright notice and this permission notice shall be 146 | included in all copies or substantial portions of the Software. 147 | 148 | THE SOFTWARE IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, 149 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 150 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 151 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 152 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 153 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 154 | WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 155 | 156 | ==== 157 | 158 | All files located in the node_modules and external directories are 159 | externally maintained libraries used by this software which have their 160 | own licenses; we recommend you read them, as their terms may differ from 161 | the terms above. 162 | 163 | 164 | 165 | lodash 166 | The MIT License 167 | 168 | Copyright JS Foundation and other contributors 169 | 170 | Based on Underscore.js, copyright Jeremy Ashkenas, 171 | DocumentCloud and Investigative Reporters & Editors 172 | 173 | This software consists of voluntary contributions made by many 174 | individuals. For exact contribution history, see the revision history 175 | available at https://github.com/lodash/lodash 176 | 177 | The following license applies to all parts of this software except as 178 | documented below: 179 | 180 | ==== 181 | 182 | Permission is hereby granted, free of charge, to any person obtaining 183 | a copy of this software and associated documentation files (the 184 | "Software"), to deal in the Software without restriction, including 185 | without limitation the rights to use, copy, modify, merge, publish, 186 | distribute, sublicense, and/or sell copies of the Software, and to 187 | permit persons to whom the Software is furnished to do so, subject to 188 | the following conditions: 189 | 190 | The above copyright notice and this permission notice shall be 191 | included in all copies or substantial portions of the Software. 192 | 193 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 194 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 195 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 196 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 197 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 198 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 199 | WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 200 | 201 | ==== 202 | 203 | Copyright and related rights for sample code are waived via CC0. Sample 204 | code is defined as all source code displayed within the prose of the 205 | documentation. 206 | 207 | CC0: http://creativecommons.org/publicdomain/zero/1.0/ 208 | 209 | ==== 210 | 211 | Files located in the node_modules and vendor directories are externally 212 | maintained libraries used by this software which have their own 213 | licenses; we recommend you read them, as their terms may differ from the 214 | terms above. 215 | 216 | 217 | typescript-string-operations 218 | MIT License 219 | 220 | Copyright (c) 2017 Sven Ulrich 221 | 222 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the &quot;Software&quot;), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 223 | 224 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 225 | 226 | THE SOFTWARE IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 227 | 228 | 229 | vscode-extension-telemetry 230 | The MIT License (MIT) 231 | 232 | Copyright (c) Microsoft Corporation 233 | 234 | Permission is hereby granted, free of charge, to any person obtaining a copy 235 | of this software and associated documentation files (the "Software"), to deal 236 | in the Software without restriction, including without limitation the rights 237 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 238 | copies of the Software, and to permit persons to whom the Software is 239 | furnished to do so, subject to the following conditions: 240 | 241 | The above copyright notice and this permission notice shall be included in all 242 | copies or substantial portions of the Software. 243 | 244 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 245 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 246 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 247 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 248 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 249 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 250 | SOFTWARE. 251 | 252 | proleap-cobol-parser 253 | MIT License 254 | 255 | Copyright (c) 2017 Ulrich Wolffgang 256 | 257 | Permission is hereby granted, free of charge, to any person obtaining a copy 258 | of this software and associated documentation files (the "Software"), to deal 259 | in the Software without restriction, including without limitation the rights 260 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 261 | copies of the Software, and to permit persons to whom the Software is 262 | furnished to do so, subject to the following conditions: 263 | 264 | The above copyright notice and this permission notice shall be included in all 265 | copies or substantial portions of the Software. 266 | 267 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 268 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 269 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 270 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 271 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 272 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 273 | SOFTWARE. 274 | 275 | 276 | sinon 277 | (The BSD License) 278 | 279 | Copyright (c) 2010-2017, Christian Johansen, christian@cjohansen.no 280 | All rights reserved. 281 | 282 | Redistribution and use in source and binary forms, with or without modification, 283 | are permitted provided that the following conditions are met: 284 | 285 | * Redistributions of source code must retain the above copyright notice, 286 | this list of conditions and the following disclaimer. 287 | * Redistributions in binary form must reproduce the above copyright notice, 288 | this list of conditions and the following disclaimer in the documentation 289 | and/or other materials provided with the distribution. 290 | * Neither the name of Christian Johansen nor the names of his contributors 291 | may be used to endorse or promote products derived from this software 292 | without specific prior written permission. 293 | 294 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 295 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 296 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 297 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 298 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 299 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 300 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 301 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 302 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 303 | THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 304 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 7 | 8 | # COBOL Control Flow 9 | 10 | COBOL Control Flow is an extension for Visual Studio Code that provides graphical visualization of program flow for programs written in COBOL. The extension is designed to help COBOL developers to quickly comprehend and debug COBOL programs with which they might not be familiar. 11 | 12 | COBOL Control Flow displays paragraphs of a COBOL program as graphical nodes in an interactive graph. The edges of the graph are drawn based on the 'PERFORM' COBOL execution statements. You can interact with the graph to navigate to the relevant parts of the COBOL code, or you can navigate from the COBOL code to the relevant nodes in the graph. 13 | 14 | COBOL Control Flow is part of [Code4z](https://techdocs.broadcom.com/code4z), an all-round VS Code extension package that offers a modern experience for mainframe application developers, including tools for language support, data editing, testing, and source code management. For an interactive overview of Code4z, see the [Code4z Developer Cockpit](https://mainframe.broadcom.com/code4z-developer-cockpit). 15 | 16 | COBOL Control Flow requires [COBOL Language Support](https://marketplace.visualstudio.com/items?itemName=broadcomMFD.COBOL-language-support) to run. We also recommend installing [Zowe Explorer](https://marketplace.visualstudio.com/items?itemName=Zowe.vscode-extension-for-zowe) to unlock all features of the extension. All three extensions are included in the Code4z extension pack. 17 | 18 | This extension is Zowe v3 conformant 19 | 20 | ## Prerequisites 21 | 22 | - [COBOL Language Support](https://marketplace.visualstudio.com/items?itemName=broadcomMFD.COBOL-language-support) to run 23 | 24 | ## Getting Started 25 | 26 | ### Supported IDEs 27 | 28 | - Visual Studio Code version 1.46.0 or higher 29 | - Github Codespaces 30 | 31 | ### Compatibility 32 | 33 | The COBOL Control Flow extension only supports IBM Enterprise COBOL. Other versions of COBOL are not supported. 34 | 35 | ### Integration with COBOL Language Support and Zowe Explorer 36 | 37 | We recommend that you download and install [Zowe Explorer](https://marketplace.visualstudio.com/items?itemName=Zowe.vscode-extension-for-zowe) and configure COBOL Language Support to enhance the functionality of COBOL Control Flow. Advantages of integrating COBOL Control Flow with these two extensions include: 38 | 39 | - Ability to load your data sets containing COBOL code directly from the Zowe Explorer data set tree. 40 | - Support for copybooks, including IDMS copybooks, stored both locally in your workspace and on mainframe data sets. 41 | - Support for EXEC CICS and EXEC SQL statements. 42 | - Support for dialects of COBOL such as IDMS. 43 | - More precise graphs generated by the COBOL Language Support code parser. 44 | 45 | Both the COBOL Language Support and Zowe Explorer extensions can be installed using the [Code4z extension pack](https://marketplace.visualstudio.com/items?itemName=broadcomMFD.code4z-extension-pack). 46 | 47 | ## Using COBOL Control Flow 48 | 49 | ### Generate a COBOL Control Graph 50 | 51 | To use the COBOL Control Flow interactive graph, generate it in the VS Code interface. 52 | ![](https://github.com/BroadcomMFD/cobol-control-flow/blob/8058b54cf40bbe60f83d79f6c915a8fda7fc9188/generate_flow.gif?raw=true) 53 | 54 | **Follow these steps:** 55 | 1. Open a COBOL file. 56 | 2. Right click inside the file editor. 57 | - The context menu opens. 58 | 3. Select **Generate COBOL Control Flow**. 59 | - The COBOL Control Flow graph is generated and displayed in a new window located to the side of the COBOL file. 60 | 61 | ### Navigate Through the Code Using the COBOL Control Graph 62 | 63 | Once the COBOL Control Flow graph is generated you can navigate through the COBOL code by clicking on the individual nodes in the graph. 64 | 65 | ![](https://github.com/BroadcomMFD/cobol-control-flow/blob/8058b54cf40bbe60f83d79f6c915a8fda7fc9188/highlighting_code.gif?raw=true) 66 | 67 | You can also click anywhere in the COBOL code to navigate to the relevant node in the graph. 68 | 69 | If you change the code, use the **Reset graph** button in the toolbar to update the graph. 70 | 71 | To return to the program root in the graph and in the code, use the **Focus on Program Root** button in the toolbar. 72 | 73 | ### Display Tooltips 74 | 75 | Hover over a node in the COBOL Control Flow graph to display the first several lines of the corresponding paragraph. 76 | 77 | ![](https://github.com/BroadcomMFD/cobol-control-flow/blob/8058b54cf40bbe60f83d79f6c915a8fda7fc9188/tooltip.gif?raw=true) 78 | 79 | ### Export Options 80 | 81 | The CCF graph can be exported to PNG, JSON or DOT string formats. 82 | 83 | To download a PNG of the graph, use the **Download PNG** button in the toolbar. 84 | 85 | To export the graph as a JSON or DOT string file, press **F1** to open the command palette and run the command **COBOL Control Flow: Export CCF Graph to JSON** or **COBOL Control Flow: Export CCF Graph to DOT Language**. The resulting code opens in the VS Code editor window. 86 | 87 | ![](https://github.com/BroadcomMFD/cobol-control-flow/blob/8058b54cf40bbe60f83d79f6c915a8fda7fc9188/export_options.gif?raw=true) 88 | 89 | ## Copybook Support 90 | 91 | COBOL Control Flow displays paragraphs in copybooks on the interactive graph as long as they are stored in a folder in your workspace. You can configure COBOL Language Support to restrict local copybook support to certain folders or processor groups, enable support for IDMS copybooks, and retrieve copybooks from mainframe data sets and USS files. For remote copybook retrieval, the [Zowe Explorer](https://marketplace.visualstudio.com/items?itemName=Zowe.vscode-extension-for-zowe) extension is also required. 92 | 93 | For instructions on how to configure COBOL Language Support, see the **Copybook Support** section of the **[COBOL Language Support documentation](https://github.com/eclipse/che-che4z-lsp-for-cobol#readme)**. 94 | 95 | ## Further Reading 96 | - [Visualization of COBOL Programs on VS Code](https://medium.com/@pamela.deason/visualization-of-cobol-programs-in-vs-code-4e67210b8b9f) (on Medium) 97 | 98 | ## Known Issues 99 | 100 | The COBOL USE statement is not supported by COBOL Control Flow. A COBOL program containing this statement generates an incorrect graph. 101 | 102 | If you encounter any other statements which are not processed correctly by COBOL Control Flow, please raise an [issue](https://github.com/BroadcomMFD/cobol-control-flow/issues?q=is%3Aissue+is%3Aopen+label%3A%22missing+statements%22) on the COBOL Control Flow GitHub repository. 103 | 104 | ## Technical Assistance and Support for COBOL Control Flow 105 | 106 | The COBOL Control Flow extension is made available to customers on the Visual Studio Code Marketplace in accordance with the terms and conditions contained in the provided End-User License Agreement (EULA). 107 | 108 | If you are on active support for Brightside, you get technical assistance and support in accordance with the terms, guidelines, details, and parameters that are located within the Broadcom [Working with Support](https://support.broadcom.com/external/content/release-announcements/CA-Support-Policies/6933) guide. 109 | 110 | This support generally includes: 111 | 112 | * Telephone and online access to technical support 113 | * Ability to submit new incidents 24x7x365 114 | * 24x7x365 continuous support for Severity 1 incidents 115 | * 24x7x365 access to Broadcom Support 116 | * Interactive remote diagnostic support 117 | * Technical support cases must be submitted to Broadcom in accordance with guidance provided in “Working with Support”. 118 | 119 | Note: To receive technical assistance and support, you must remain compliant with “Working with Support”, be current on all applicable licensing and maintenance requirements, and maintain an environment in which all computer hardware, operating systems, and third party software associated with the affected Broadcom software are on the releases and version levels from the manufacturer that Broadcom designates as compatible with the software. Changes you elect to make to your operating environment could detrimentally affect the performance of Broadcom software and Broadcom shall not be responsible for these effects or any resulting degradation in performance of the Broadcom software. Severity 1 cases must be opened via telephone and elevations of lower severity incidents to Severity 1 status must be requested via telephone. 120 | 121 | ## Privacy Notice 122 | The extensions for Visual Studio Code developed by Broadcom Inc., including its corporate affiliates and subsidiaries, ("Broadcom") are provided free of charge, but in order to better understand and meet its users’ needs, Broadcom may collect, use, analyze and retain anonymous users’ metadata and interaction data, (collectively, “Usage Data”) and aggregate such Usage Data with similar Usage Data of other Broadcom customers. Please find more detailed information in License and Service Terms & Repository. 123 | 124 | This data collection uses built-in Microsoft VS Code Telemetry, which can be disabled, at your sole discretion, if you do not want to send Usage Data. 125 | 126 | The current release of COBOL Control Flow collects anonymous data for the following events: 127 | - Activation of this VS Code extension 128 | - Interaction with the nodes 129 | - Use of zoom 130 | - Collapse and expand of graph edges 131 | - Count of lines of analyzed COBOL file (Performance) 132 | - Parsing time (Performance) 133 | - Rendering time (Performance) 134 | - Errors 135 | 136 | Each such event is logged with the following information: 137 | - Event time 138 | - Operating system and version 139 | - Country or region 140 | - Anonymous user and session ID 141 | - Version numbers of Microsoft VS Code and COBOL Control Flow 142 | -------------------------------------------------------------------------------- /export_options.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/BroadcomMFD/cobol-control-flow/9dd5b6f03b60ae2806143afe577a4810a54e930a/export_options.gif -------------------------------------------------------------------------------- /generate_flow.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/BroadcomMFD/cobol-control-flow/9dd5b6f03b60ae2806143afe577a4810a54e930a/generate_flow.gif -------------------------------------------------------------------------------- /highlighting_code.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/BroadcomMFD/cobol-control-flow/9dd5b6f03b60ae2806143afe577a4810a54e930a/highlighting_code.gif -------------------------------------------------------------------------------- /sample/SLICKP0.cbl: -------------------------------------------------------------------------------- 1 | CBL XOPTS(COBOL2) 2 | IDENTIFICATION DIVISION. 3 | PROGRAM-ID. SLICKP0. 4 | AUTHOR. Ira M. Slick. 5 | ****************************************************************** 6 | *DESCRIPTION:Main menu program * 7 | ****************************************************************** 8 | ENVIRONMENT DIVISION. 9 | CONFIGURATION SECTION. 10 | SOURCE-COMPUTER. IBM-PC. 11 | OBJECT-COMPUTER. IBM-PC. 12 | DATA DIVISION. 13 | WORKING-STORAGE SECTION. 14 | 15 | COPY SLICKCOM. 16 | 17 | COPY SLICKM0. 18 | 19 | COPY DFHAID. 20 | 21 | COPY DFHBMSCA. 22 | 23 | COPY ACCTFILE. 24 | 25 | 01 WS-TIME PIC 9(15) COMP-3. 26 | 27 | 01 WS-DATE. 28 | 03 WS-DATE-YY PIC 9(2). 29 | 03 FILLER PIC X(1). 30 | 03 WS-DATE-MM PIC 9(2). 31 | 03 FILLER PIC X(1). 32 | 03 WS-DATE-DD PIC 9(2). 33 | 34 | 01 WS-DISPLAY-DATE. 35 | 03 WS-DISPLAY-DATE-MMM PIC X(3). 36 | 03 FILLER PIC X(1) VALUE ' '. 37 | 03 WS-DISPLAY-DATE-DD PIC 9(2). 38 | 03 FILLER PIC X(2) VALUE ', '. 39 | 03 WS-DISPLAY-DATE-CC PIC 9(2). 40 | 03 WS-DISPLAY-DATE-YY PIC 9(2). 41 | 42 | 01 WS-TRAN-DATE. 43 | 03 WS-TRAN-DATE-YY PIC 9(2). 44 | 03 WS-TRAN-DATE-MM PIC 9(2). 45 | 03 WS-TRAN-DATE-DD PIC 9(2). 46 | 47 | 01 WS-MONTH-NAMES. 48 | 03 FILLER PIC X(3) VALUE 'Jan'. 49 | 03 FILLER PIC X(3) VALUE 'Feb'. 50 | 03 FILLER PIC X(3) VALUE 'Mar'. 51 | 03 FILLER PIC X(3) VALUE 'Apr'. 52 | 03 FILLER PIC X(3) VALUE 'May'. 53 | 03 FILLER PIC X(3) VALUE 'Jun'. 54 | 03 FILLER PIC X(3) VALUE 'Jul'. 55 | 03 FILLER PIC X(3) VALUE 'Aug'. 56 | 03 FILLER PIC X(3) VALUE 'Sep'. 57 | 03 FILLER PIC X(3) VALUE 'Oct'. 58 | 03 FILLER PIC X(3) VALUE 'Nov'. 59 | 03 FILLER PIC X(3) VALUE 'Dec'. 60 | 61 | 01 FILLER REDEFINES WS-MONTH-NAMES. 62 | 03 WS-MONTH PIC X(3) OCCURS 12. 63 | 64 | 01 WS-EXIT PIC X(11) VALUE 65 | 'Slick ended'. 66 | 67 | LINKAGE SECTION. 68 | 69 | 01 DFHCOMMAREA. 70 | 03 FILLER PIC X(01) 71 | OCCURS 1 TO 4096 TIMES 72 | DEPENDING ON EIBCALEN. 73 | * 74 | PROCEDURE DIVISION. 75 | 76 | 000-START-PROCESSING. 77 | 78 | IF EIBCALEN > ZERO 79 | MOVE DFHCOMMAREA TO SLICK-COMM. 80 | 81 | MOVE LOW-VALUES TO SLICKM0I. 82 | 83 | IF COMM-INIT 84 | PERFORM 000-INITIALIZATION 85 | ELSE 86 | PERFORM 000-RECEIVE-MAP. 87 | 88 | IF COMM-NEXT-TRAN = EIBTRNID 89 | PERFORM 000-SEND-MAP 90 | EXEC CICS RETURN 91 | TRANSID (COMM-NEXT-TRAN) 92 | COMMAREA (SLICK-COMM) 93 | END-EXEC 94 | ELSE 95 | MOVE 'Y' TO COMM-INIT-FLAG 96 | 97 | IF COMM-UPDATE 98 | OR COMM-HISTORY 99 | OR COMM-STATUS 100 | 101 | EXEC CICS RETURN 102 | TRANSID ('SLKA') 103 | COMMAREA (SLICK-COMM) 104 | IMMEDIATE 105 | END-EXEC 106 | 107 | ELSE 108 | IF COMM-QUIT 109 | 110 | EXEC CICS SEND TEXT 111 | FROM (WS-EXIT) 112 | LENGTH (11) 113 | FREEKB 114 | ERASE 115 | END-EXEC 116 | 117 | EXEC CICS RETURN 118 | END-EXEC 119 | 120 | ELSE 121 | EXEC CICS RETURN 122 | TRANSID (COMM-NEXT-TRAN) 123 | COMMAREA (SLICK-COMM) 124 | IMMEDIATE 125 | END-EXEC. 126 | 127 | 000-INITIALIZATION. 128 | 129 | MOVE EIBTRNID TO COMM-NEXT-TRAN. 130 | MOVE SPACE TO COMM-INIT-FLAG. 131 | 132 | IF EIBCALEN = ZERO 133 | PERFORM 000-VERIFY-ACCOUNT-FILE. 134 | 135 | 000-VERIFY-ACCOUNT-FILE. 136 | 137 | EXEC CICS READ 138 | FILE ('ACCTFILE') 139 | INTO (ACCOUNT-CONTROL-RECORD) 140 | RIDFLD (A-C-KEY) 141 | LENGTH (ACCTFILE-LENGTH) 142 | KEYLENGTH (ACCTFILE-KEYLENGTH) 143 | RESP (ACCTFILE-RESP) 144 | END-EXEC. 145 | 146 | IF ACCTFILE-RESP NOT = DFHRESP(NORMAL) 147 | 148 | MOVE 1001 TO A-C-MIN-ACCOUNT-ID 149 | MOVE 1000 TO A-C-MAX-ACCOUNT-ID 150 | 151 | EXEC CICS WRITE 152 | FILE ('ACCTFILE') 153 | FROM (ACCOUNT-CONTROL-RECORD) 154 | RIDFLD (A-C-KEY) 155 | LENGTH (ACCTFILE-LENGTH) 156 | KEYLENGTH (ACCTFILE-KEYLENGTH) 157 | RESP (ACCTFILE-RESP) 158 | END-EXEC 159 | 160 | IF ACCTFILE-RESP NOT = DFHRESP(NORMAL) 161 | 162 | MOVE 'SE00' TO COMM-ABCODE 163 | EXEC CICS ABEND 164 | ABCODE (COMM-ABCODE) 165 | NODUMP 166 | END-EXEC. 167 | 168 | MOVE A-C-MIN-ACCOUNT-ID TO COMM-MIN-ACCOUNT-ID. 169 | MOVE A-C-MAX-ACCOUNT-ID TO COMM-MAX-ACCOUNT-ID. 170 | 171 | 000-SEND-MAP. 172 | 173 | EXEC CICS ASKTIME 174 | ABSTIME (WS-TIME) 175 | END-EXEC. 176 | 177 | EXEC CICS FORMATTIME 178 | ABSTIME (WS-TIME) 179 | DATESEP ('/') 180 | YYMMDD (WS-DATE) 181 | END-EXEC. 182 | 183 | Y2K IF WS-DATE-YY > 80 184 | Y2K MOVE 19 TO WS-DISPLAY-DATE-CC 185 | Y2K ELSE 186 | Y2K MOVE 20 TO WS-DISPLAY-DATE-CC. 187 | 188 | MOVE WS-MONTH (WS-DATE-MM) TO WS-DISPLAY-DATE-MMM. 189 | MOVE WS-DATE-DD TO WS-DISPLAY-DATE-DD. 190 | MOVE WS-DATE-YY TO WS-DISPLAY-DATE-YY. 191 | Y2K * MOVE 19 TO WS-DISPLAY-DATE-CC. 192 | MOVE WS-DISPLAY-DATE TO COMM-DISPLAY-DATE. 193 | 194 | MOVE WS-DATE-YY TO WS-TRAN-DATE-YY. 195 | MOVE WS-DATE-MM TO WS-TRAN-DATE-MM. 196 | MOVE WS-DATE-DD TO WS-TRAN-DATE-DD. 197 | MOVE WS-TRAN-DATE TO COMM-TRAN-DATE. 198 | 199 | MOVE COMM-DISPLAY-DATE TO M0DATEO. 200 | MOVE COMM-MESSAGE TO M0MSGO. 201 | MOVE SPACE TO COMM-MESSAGE. 202 | 203 | IF COMM-MIN-ACCOUNT-ID > COMM-MAX-ACCOUNT-ID 204 | MOVE DFHBMDAR TO M0PF2A 205 | MOVE DFHBMDAR TO M0PF3A 206 | MOVE DFHBMDAR TO M0PF4A 207 | MOVE DFHBMDAR TO M0PF5A 208 | MOVE DFHBMDAR TO M0PF6A 209 | ELSE 210 | MOVE DFHBMASB TO M0PF2A 211 | MOVE DFHBMASB TO M0PF3A 212 | MOVE DFHBMASB TO M0PF4A 213 | MOVE DFHBMASB TO M0PF5A 214 | MOVE DFHBMASB TO M0PF6A. 215 | 216 | EXEC CICS SEND MAP ('SLICKM0') 217 | CURSOR 218 | ERASE 219 | END-EXEC. 220 | 221 | IF M0MSGO NOT = SPACE 222 | PERFORM 000-ALARM. 223 | 224 | 000-RECEIVE-MAP. 225 | 226 | IF EIBAID = DFHPF1 227 | MOVE 'Add' TO COMM-FUNCTION 228 | SET COMM-ADD TO TRUE 229 | ELSE 230 | IF EIBAID = DFHPF12 231 | OR EIBAID = DFHPF24 232 | MOVE 'Quit' TO COMM-FUNCTION 233 | SET COMM-QUIT TO TRUE 234 | ELSE 235 | IF COMM-MIN-ACCOUNT-ID > COMM-MAX-ACCOUNT-ID 236 | MOVE 'Invalid key.' TO COMM-MESSAGE 237 | ELSE 238 | IF EIBAID = DFHPF2 239 | MOVE 'List' TO COMM-FUNCTION 240 | SET COMM-LIST TO TRUE 241 | ELSE 242 | IF EIBAID = DFHPF3 243 | MOVE 'Update' TO COMM-FUNCTION 244 | SET COMM-UPDATE TO TRUE 245 | ELSE 246 | IF EIBAID = DFHPF4 247 | MOVE 'History' TO COMM-FUNCTION 248 | SET COMM-HISTORY TO TRUE 249 | ELSE 250 | IF EIBAID = DFHPF5 251 | MOVE 'Status' TO COMM-FUNCTION 252 | SET COMM-STATUS TO TRUE 253 | ELSE 254 | IF EIBAID = DFHPF6 255 | MOVE 'Schedule' TO COMM-FUNCTION 256 | SET COMM-SCHEDULE TO TRUE 257 | ELSE 258 | MOVE 'Invalid Key.' TO COMM-MESSAGE. 259 | 260 | 000-ALARM. 261 | 262 | EXEC CICS SEND CONTROL 263 | ALARM 264 | FREEKB 265 | END-EXEC. 266 | 267 | 268 | 269 | 270 | -------------------------------------------------------------------------------- /sample/SLICKP1.cbl: -------------------------------------------------------------------------------- 1 | CBL XOPTS(COBOL2) 2 | IDENTIFICATION DIVISION. 3 | PROGRAM-ID. SLICKP1. 4 | AUTHOR. Ira M. Slick. 5 | ****************************************************************** 6 | *DESCRIPTION: Add Account * 7 | ****************************************************************** 8 | ENVIRONMENT DIVISION. 9 | CONFIGURATION SECTION. 10 | SOURCE-COMPUTER. IBM-PC. 11 | OBJECT-COMPUTER. IBM-PC. 12 | DATA DIVISION. 13 | WORKING-STORAGE SECTION. 14 | 15 | COPY SLICKCOM. 16 | 17 | COPY SLICKM1. 18 | 19 | COPY DFHAID. 20 | 21 | COPY ACCTFILE. 22 | 23 | 01 WS-MAP-FIELDS. 24 | 03 WS-NAME-LAST PIC X(16) VALUE SPACE. 25 | 03 WS-NAME-FIRST PIC X(16) VALUE SPACE. 26 | 03 WS-NAME-INITIAL PIC X(01) VALUE SPACE. 27 | 03 WS-ADDRESS PIC X(64) VALUE SPACE. 28 | 03 WS-CITY PIC X(24) VALUE SPACE. 29 | 03 WS-STATE PIC X(02) VALUE SPACE. 30 | 03 WS-ZIP PIC 9(05) VALUE ZERO. 31 | 03 WS-ZIP-EX PIC 9(04) VALUE ZERO. 32 | 03 WS-TEL-1A PIC 9(03) VALUE ZERO. 33 | 03 WS-TEL-1B PIC 9(03) VALUE ZERO. 34 | 03 WS-TEL-1C PIC 9(04) VALUE ZERO. 35 | 03 WS-TEL-2A PIC 9(03) VALUE ZERO. 36 | 03 WS-TEL-2B PIC 9(03) VALUE ZERO. 37 | 03 WS-TEL-2C PIC 9(04) VALUE ZERO. 38 | 03 WS-SIZE-OF-HOME PIC 9(04) VALUE ZERO. 39 | 03 WS-SIZE-OF-TANK PIC 9(04) VALUE ZERO. 40 | 03 WS-UNIT-PRICE PIC 9(05) VALUE ZERO. 41 | 03 WS-LAST-AID PIC X(01) VALUE SPACE. 42 | 43 | 01 TEMP-DATE. 44 | 03 TEMP-YY PIC 9(02) VALUE ZERO. 45 | 03 TEMP-MM PIC 9(02) VALUE ZERO. 46 | 03 TEMP-DD PIC 9(02) VALUE ZERO. 47 | 48 | 01 ACCOUNT-ADDED-MESSAGE. 49 | 03 FILLER PIC X(08) VALUE 'Account '. 50 | 03 A-A-ACCOUNT-ID PIC 9(04) VALUE ZERO. 51 | 03 FILLER PIC X(07) VALUE ' added.'. 52 | 53 | 01 WS-EXIT PIC X(11) VALUE 54 | 'Slick ended'. 55 | 56 | LINKAGE SECTION. 57 | 58 | 01 DFHCOMMAREA. 59 | 03 FILLER PIC X(01) 60 | OCCURS 1 TO 4096 TIMES 61 | DEPENDING ON EIBCALEN. 62 | 63 | PROCEDURE DIVISION. 64 | 65 | 000-START-PROCESSING. 66 | 67 | MOVE DFHCOMMAREA TO SLICK-COMM. 68 | MOVE LOW-VALUES TO SLICKM1I. 69 | 70 | IF COMM-INIT 71 | PERFORM 000-INITIALIZATION 72 | 73 | ELSE 74 | MOVE COMM-SAVE TO WS-MAP-FIELDS 75 | PERFORM 000-RECEIVE-MAP. 76 | 77 | IF COMM-NEXT-TRAN = EIBTRNID 78 | MOVE WS-MAP-FIELDS TO COMM-SAVE 79 | PERFORM 000-SEND-MAP 80 | 81 | EXEC CICS RETURN 82 | TRANSID (COMM-NEXT-TRAN) 83 | COMMAREA (SLICK-COMM) 84 | END-EXEC 85 | 86 | ELSE 87 | SET COMM-INIT TO TRUE 88 | 89 | IF COMM-QUIT 90 | 91 | EXEC CICS SEND TEXT 92 | FROM (WS-EXIT) 93 | LENGTH (11) 94 | FREEKB 95 | ERASE 96 | END-EXEC 97 | 98 | EXEC CICS RETURN 99 | END-EXEC 100 | 101 | ELSE 102 | 103 | EXEC CICS RETURN 104 | TRANSID (COMM-NEXT-TRAN) 105 | COMMAREA (SLICK-COMM) 106 | IMMEDIATE 107 | END-EXEC. 108 | 109 | 000-INITIALIZATION. 110 | 111 | MOVE EIBTRNID TO COMM-NEXT-TRAN. 112 | MOVE SPACE TO COMM-INIT-FLAG. 113 | 114 | 000-SEND-MAP. 115 | 116 | MOVE COMM-DISPLAY-DATE TO M1DATEO. 117 | MOVE COMM-MESSAGE TO M1MSGO. 118 | MOVE SPACE TO COMM-MESSAGE. 119 | 120 | IF NOT BAD-DATA 121 | MOVE -1 TO M1LASTL. 122 | 123 | EXEC CICS SEND 124 | MAP ('SLICKM1') 125 | CURSOR 126 | ERASE 127 | END-EXEC. 128 | 129 | IF M1MSGO NOT = SPACE 130 | PERFORM 000-ALARM. 131 | 132 | 000-RECEIVE-MAP. 133 | 134 | IF EIBAID = DFHPF11 135 | MOVE 'Transaction cancelled.' TO COMM-MESSAGE 136 | SET COMM-MENU TO TRUE 137 | ELSE 138 | IF EIBAID = DFHPF12 139 | OR EIBAID = DFHPF24 140 | SET COMM-QUIT TO TRUE 141 | ELSE 142 | PERFORM 000-PROCESS-FIELDS 143 | MOVE EIBAID TO WS-LAST-AID. 144 | 145 | 000-PROCESS-FIELDS. 146 | 147 | EXEC CICS RECEIVE 148 | MAP ('SLICKM1') 149 | RESP (COMM-RESP) 150 | END-EXEC. 151 | 152 | PERFORM 000-VALIDATE-MAP-FIELDS. 153 | SET MAP-RECEIVED TO TRUE. 154 | 155 | IF EIBAID = DFHENTER 156 | NEXT SENTENCE 157 | ELSE 158 | IF EIBAID NOT = DFHPF1 159 | MOVE 'Invalid Key.' 160 | TO COMM-MESSAGE 161 | ELSE 162 | IF BAD-DATA 163 | MOVE 'Enter required field(s).' 164 | TO COMM-MESSAGE 165 | ELSE 166 | IF WS-LAST-AID NOT = DFHPF1 167 | OR MAP-CHANGED 168 | MOVE 'Hit PF1 to confirm request.' 169 | TO COMM-MESSAGE 170 | ELSE 171 | PERFORM 000-ADD-ACCOUNT. 172 | 173 | 000-VALIDATE-MAP-FIELDS. 174 | 175 | * Unit Cost (Required) 176 | IF M1UNITL = ZERO 177 | MOVE WS-UNIT-PRICE TO NUM-5 178 | MOVE DOLLARS-5 TO D-5 179 | MOVE CENTS-5 TO C-5 180 | MOVE DC-5 TO M1UNITI 181 | ELSE 182 | SET MAP-CHANGED TO TRUE 183 | MOVE 5 TO WS-FIELD-SIZE 184 | MOVE M1UNITI TO CH-ARRAY 185 | PERFORM 000-MONEY-FIELD 186 | MOVE CH-ARRAY TO WS-UNIT-PRICE 187 | MOVE DC-5 TO M1UNITI. 188 | 189 | IF WS-UNIT-PRICE = ZERO 190 | SET BAD-DATA TO TRUE 191 | MOVE -1 TO M1UNITL. 192 | 193 | * Tank Size (Required) 194 | IF M1TANKL = ZERO 195 | MOVE WS-SIZE-OF-TANK TO M1TANKI 196 | ELSE 197 | SET MAP-CHANGED TO TRUE 198 | MOVE 4 TO WS-FIELD-SIZE 199 | MOVE M1TANKI TO CH-ARRAY 200 | PERFORM 000-NUM-FIELD 201 | MOVE CH-ARRAY TO WS-SIZE-OF-TANK 202 | MOVE CH-ARRAY TO M1TANKI. 203 | 204 | IF WS-SIZE-OF-TANK = ZERO 205 | SET BAD-DATA TO TRUE 206 | MOVE -1 TO M1TANKL. 207 | 208 | * Home Size (Required) 209 | IF M1HOMEL = ZERO 210 | MOVE WS-SIZE-OF-HOME TO M1HOMEI 211 | ELSE 212 | SET MAP-CHANGED TO TRUE 213 | MOVE 4 TO WS-FIELD-SIZE 214 | MOVE M1HOMEI TO CH-ARRAY 215 | PERFORM 000-NUM-FIELD 216 | MOVE CH-ARRAY TO WS-SIZE-OF-HOME 217 | MOVE CH-ARRAY TO M1HOMEI. 218 | 219 | IF WS-SIZE-OF-HOME = ZERO 220 | SET BAD-DATA TO TRUE 221 | MOVE -1 TO M1HOMEL. 222 | 223 | * Office Telephone (Optional) 224 | IF M1TEL2CL = ZERO 225 | MOVE WS-TEL-2C TO M1TEL2CI 226 | ELSE 227 | SET MAP-CHANGED TO TRUE 228 | MOVE 3 TO WS-FIELD-SIZE 229 | MOVE M1TEL2CI TO CH-ARRAY 230 | PERFORM 000-NUM-FIELD 231 | MOVE CH-ARRAY TO WS-TEL-2C 232 | MOVE CH-ARRAY TO M1TEL2CI. 233 | 234 | * Office Telephone Exchange (Optional) 235 | IF M1TEL2BL = ZERO 236 | MOVE WS-TEL-2B TO M1TEL2BI 237 | ELSE 238 | SET MAP-CHANGED TO TRUE 239 | MOVE 3 TO WS-FIELD-SIZE 240 | MOVE M1TEL2BI TO CH-ARRAY 241 | PERFORM 000-NUM-FIELD 242 | MOVE CH-ARRAY TO WS-TEL-2B 243 | MOVE CH-ARRAY TO M1TEL2BI. 244 | 245 | * Office Telephone Area Code (Optional) 246 | IF M1TEL2AL = ZERO 247 | MOVE WS-TEL-2A TO M1TEL2AI 248 | ELSE 249 | SET MAP-CHANGED TO TRUE 250 | MOVE 3 TO WS-FIELD-SIZE 251 | MOVE M1TEL2AI TO CH-ARRAY 252 | PERFORM 000-NUM-FIELD 253 | MOVE CH-ARRAY TO WS-TEL-2A 254 | MOVE CH-ARRAY TO M1TEL2AI. 255 | 256 | * Home Telephone (Required) 257 | IF M1TEL1CL = ZERO 258 | MOVE WS-TEL-1C TO M1TEL1CI 259 | ELSE 260 | SET MAP-CHANGED TO TRUE 261 | MOVE 4 TO WS-FIELD-SIZE 262 | MOVE M1TEL1CI TO CH-ARRAY 263 | PERFORM 000-NUM-FIELD 264 | MOVE CH-ARRAY TO WS-TEL-1C 265 | MOVE CH-ARRAY TO M1TEL1CI. 266 | 267 | * Home Telephone Exchange (Required) 268 | IF M1TEL1BL = ZERO 269 | MOVE WS-TEL-1B TO M1TEL1BI 270 | ELSE 271 | SET MAP-CHANGED TO TRUE 272 | MOVE 3 TO WS-FIELD-SIZE 273 | MOVE M1TEL1BI TO CH-ARRAY 274 | PERFORM 000-NUM-FIELD 275 | MOVE CH-ARRAY TO WS-TEL-1B 276 | MOVE CH-ARRAY TO M1TEL1BI. 277 | 278 | IF WS-TEL-1B = ZERO 279 | SET BAD-DATA TO TRUE 280 | MOVE -1 TO M1TEL1BL. 281 | 282 | * Home Telephone Area Code (Required) 283 | IF M1TEL1AL = ZERO 284 | MOVE WS-TEL-1A TO M1TEL1AI 285 | ELSE 286 | SET MAP-CHANGED TO TRUE 287 | MOVE 3 TO WS-FIELD-SIZE 288 | MOVE M1TEL1AI TO CH-ARRAY 289 | PERFORM 000-NUM-FIELD 290 | MOVE CH-ARRAY TO WS-TEL-1A 291 | MOVE CH-ARRAY TO M1TEL1AI. 292 | 293 | IF WS-TEL-1A = ZERO 294 | SET BAD-DATA TO TRUE 295 | MOVE -1 TO M1TEL1AL. 296 | 297 | * Extended Zip Code (Optional) 298 | IF M1ZIPXL = ZERO 299 | MOVE WS-ZIP-EX TO M1ZIPXI 300 | ELSE 301 | SET MAP-CHANGED TO TRUE 302 | MOVE 4 TO WS-FIELD-SIZE 303 | MOVE M1ZIPXI TO CH-ARRAY 304 | PERFORM 000-NUM-FIELD 305 | MOVE CH-ARRAY TO WS-ZIP-EX 306 | MOVE CH-ARRAY TO M1ZIPXI. 307 | 308 | * Zip Code (Required) 309 | IF M1ZIPL = ZERO 310 | MOVE WS-ZIP TO M1ZIPI 311 | ELSE 312 | SET MAP-CHANGED TO TRUE 313 | MOVE 5 TO WS-FIELD-SIZE 314 | MOVE M1ZIPI TO CH-ARRAY 315 | PERFORM 000-NUM-FIELD 316 | MOVE CH-ARRAY TO WS-ZIP 317 | MOVE CH-ARRAY TO M1ZIPI. 318 | 319 | IF WS-ZIP = ZERO 320 | SET BAD-DATA TO TRUE 321 | MOVE -1 TO M1ZIPL. 322 | 323 | * State Name (Required) 324 | IF M1STATEL = ZERO 325 | MOVE WS-STATE TO M1STATEI 326 | ELSE 327 | INSPECT M1STATEI REPLACING ALL '_' BY ' ' 328 | SET MAP-CHANGED TO TRUE 329 | MOVE M1STATEI TO WS-STATE. 330 | 331 | IF WS-STATE = SPACE 332 | SET BAD-DATA TO TRUE 333 | MOVE ALL '_' TO M1STATEI 334 | MOVE -1 TO M1STATEL. 335 | 336 | * City (Required) 337 | IF M1CITYL = ZERO 338 | MOVE WS-CITY TO M1CITYI 339 | ELSE 340 | INSPECT M1CITYI REPLACING ALL '_' BY ' ' 341 | SET MAP-CHANGED TO TRUE 342 | MOVE M1CITYI TO WS-CITY. 343 | 344 | IF WS-CITY = SPACE 345 | SET BAD-DATA TO TRUE 346 | MOVE ALL '_' TO M1CITYI 347 | MOVE -1 TO M1CITYL. 348 | 349 | * Address (Required) 350 | IF M1ADDRL = ZERO 351 | MOVE WS-ADDRESS TO M1ADDRI 352 | ELSE 353 | INSPECT M1ADDRI REPLACING ALL '_' BY ' ' 354 | SET MAP-CHANGED TO TRUE 355 | MOVE M1ADDRI TO WS-ADDRESS. 356 | 357 | IF WS-ADDRESS = SPACE 358 | SET BAD-DATA TO TRUE 359 | MOVE ALL '_' TO M1ADDRI 360 | MOVE -1 TO M1ADDRL. 361 | 362 | * Middle Initial (Optional) 363 | IF M1INITL = ZERO 364 | MOVE WS-NAME-INITIAL TO M1INITI 365 | ELSE 366 | INSPECT M1INITI REPLACING ALL '_' BY ' ' 367 | SET MAP-CHANGED TO TRUE 368 | MOVE M1INITI TO WS-NAME-INITIAL. 369 | 370 | IF WS-NAME-INITIAL = SPACE 371 | MOVE ALL '_' TO M1INITI. 372 | 373 | * First Name (Required) 374 | IF M1FIRSTL = ZERO 375 | MOVE WS-NAME-FIRST TO M1FIRSTI 376 | ELSE 377 | INSPECT M1FIRSTI REPLACING ALL '_' BY ' ' 378 | SET MAP-CHANGED TO TRUE 379 | MOVE M1FIRSTI TO WS-NAME-FIRST. 380 | 381 | IF WS-NAME-FIRST = SPACE 382 | SET BAD-DATA TO TRUE 383 | MOVE ALL '_' TO M1FIRSTI 384 | MOVE -1 TO M1FIRSTL. 385 | 386 | * Last Name (Required) 387 | IF M1LASTL = ZERO 388 | MOVE WS-NAME-LAST TO M1LASTI 389 | ELSE 390 | INSPECT M1LASTI REPLACING ALL '_' BY ' ' 391 | SET MAP-CHANGED TO TRUE 392 | MOVE M1LASTI TO WS-NAME-LAST. 393 | 394 | IF WS-NAME-LAST = SPACE 395 | SET BAD-DATA TO TRUE 396 | MOVE ALL '_' TO M1LASTI 397 | MOVE -1 TO M1LASTL. 398 | 399 | 000-ADD-ACCOUNT. 400 | 401 | COMPUTE COMM-ACCOUNT-ID = COMM-MAX-ACCOUNT-ID + 1. 402 | MOVE ZERO TO A-S-RECORD-NUMBER. 403 | 404 | PERFORM 000-CHECK-FOR-DUPLICATE 405 | VARYING A-S-ACCOUNT-ID FROM COMM-MIN-ACCOUNT-ID BY 1 406 | UNTIL A-S-ACCOUNT-ID = COMM-ACCOUNT-ID 407 | OR A-S-NAME-LAST = M1LASTI 408 | AND A-S-ADDRESS = M1ADDRI. 409 | 410 | IF A-S-ACCOUNT-ID < COMM-ACCOUNT-ID 411 | MOVE 'Duplicate account data.' 412 | TO COMM-MESSAGE 413 | PERFORM 000-ALARM 414 | 415 | ELSE 416 | MOVE WS-NAME-LAST TO A-S-NAME-LAST 417 | MOVE WS-NAME-FIRST TO A-S-NAME-FIRST 418 | MOVE WS-NAME-INITIAL TO A-S-NAME-INITIAL 419 | MOVE WS-ADDRESS TO A-S-ADDRESS 420 | MOVE WS-CITY TO A-S-CITY 421 | MOVE WS-STATE TO A-S-STATE 422 | MOVE WS-ZIP TO A-S-ZIP 423 | MOVE WS-ZIP-EX TO A-S-ZIP-EX 424 | MOVE WS-TEL-1A TO A-S-TEL-1A 425 | MOVE WS-TEL-1B TO A-S-TEL-1B 426 | MOVE WS-TEL-1C TO A-S-TEL-1C 427 | MOVE WS-TEL-2A TO A-S-TEL-2A 428 | MOVE WS-TEL-2B TO A-S-TEL-2B 429 | MOVE WS-TEL-2C TO A-S-TEL-2C 430 | MOVE WS-SIZE-OF-TANK TO A-S-SIZE-OF-TANK 431 | MOVE WS-SIZE-OF-HOME TO A-S-SIZE-OF-HOME 432 | MOVE WS-UNIT-PRICE TO A-S-UNIT-PRICE 433 | 434 | COMPUTE A-S-ESTIMATED-USAGE = (WS-SIZE-OF-HOME * 2) / 3 435 | 436 | COMPUTE A-S-ESTIMATED-COST = 437 | (A-S-ESTIMATED-USAGE * WS-UNIT-PRICE) 438 | 439 | COMPUTE A-S-BUDGET-AMOUNT = 440 | (((A-S-ESTIMATED-COST / 12) + 50) / 1000) * 1000 441 | 442 | MOVE COMM-TRAN-DATE TO A-S-START-OF-CONTRACT 443 | MOVE ZERO TO A-S-END-OF-CONTRACT 444 | 445 | MOVE ZERO TO A-S-MAINTENANCE-ENTRIES 446 | MOVE ZERO TO A-S-LAST-MAINTENANCE 447 | 448 | MOVE ZERO TO A-S-DELIVERY-ENTRIES 449 | MOVE ZERO TO A-S-LAST-DELIVERY 450 | 451 | MOVE ZERO TO A-S-PAYMENT-ENTRIES 452 | MOVE ZERO TO A-S-LAST-PAYMENT 453 | 454 | MOVE COMM-TRAN-DATE TO TEMP-DATE 455 | 456 | ADD 1 TO TEMP-MM 457 | 458 | IF TEMP-MM = 12 459 | MOVE 1 TO TEMP-MM 460 | ADD 1 TO TEMP-YY 461 | ELSE 462 | ADD 1 TO TEMP-MM 463 | END-IF 464 | 465 | IF TEMP-DD > 28 466 | MOVE 28 TO TEMP-DD 467 | END-IF 468 | 469 | MOVE TEMP-DATE TO A-S-PAYMENT-DUE 470 | MOVE ZERO TO A-S-BALANCE 471 | 472 | EXEC CICS WRITE 473 | FILE ('ACCTFILE') 474 | FROM (ACCOUNT-STATISTICS-RECORD) 475 | RIDFLD (A-S-KEY) 476 | LENGTH (ACCTFILE-LENGTH) 477 | KEYLENGTH (ACCTFILE-KEYLENGTH) 478 | RESP (ACCTFILE-RESP) 479 | RESP2 (ACCTFILE-RESP2) 480 | END-EXEC 481 | 482 | IF ACCTFILE-RESP NOT = DFHRESP(NORMAL) 483 | MOVE 'SE13' TO COMM-ABCODE 484 | EXEC CICS ABEND 485 | ABCODE (COMM-ABCODE) 486 | NODUMP 487 | END-EXEC 488 | ELSE 489 | EXEC CICS READ 490 | FILE ('ACCTFILE') 491 | INTO (ACCOUNT-CONTROL-RECORD) 492 | RIDFLD (A-C-KEY) 493 | LENGTH (ACCTFILE-LENGTH) 494 | KEYLENGTH (ACCTFILE-KEYLENGTH) 495 | RESP (ACCTFILE-RESP) 496 | RESP2 (ACCTFILE-RESP2) 497 | UPDATE 498 | END-EXEC 499 | 500 | MOVE A-S-ACCOUNT-ID TO A-C-MAX-ACCOUNT-ID 501 | 502 | EXEC CICS REWRITE 503 | FILE ('ACCTFILE') 504 | FROM (ACCOUNT-CONTROL-RECORD) 505 | LENGTH (ACCTFILE-LENGTH) 506 | RESP (ACCTFILE-RESP) 507 | RESP2 (ACCTFILE-RESP2) 508 | END-EXEC 509 | 510 | IF ACCTFILE-RESP NOT = DFHRESP(NORMAL) 511 | MOVE 'SE12' TO COMM-ABCODE 512 | EXEC CICS ABEND 513 | ABCODE (COMM-ABCODE) 514 | NODUMP 515 | END-EXEC 516 | ELSE 517 | MOVE A-S-ACCOUNT-ID TO COMM-MAX-ACCOUNT-ID 518 | MOVE A-S-ACCOUNT-ID TO A-A-ACCOUNT-ID 519 | MOVE ACCOUNT-ADDED-MESSAGE TO COMM-MESSAGE 520 | SET COMM-MENU TO TRUE. 521 | 522 | 000-CHECK-FOR-DUPLICATE. 523 | 524 | EXEC CICS READ 525 | FILE ('ACCTFILE') 526 | INTO (ACCOUNT-STATISTICS-RECORD) 527 | RIDFLD (A-S-KEY) 528 | LENGTH (ACCTFILE-LENGTH) 529 | KEYLENGTH (ACCTFILE-KEYLENGTH) 530 | RESP (ACCTFILE-RESP) 531 | RESP2 (ACCTFILE-RESP2) 532 | END-EXEC. 533 | 534 | IF ACCTFILE-RESP NOT = DFHRESP(NORMAL) 535 | MOVE 'SE11' TO COMM-ABCODE 536 | EXEC CICS ABEND 537 | ABCODE (COMM-ABCODE) 538 | NODUMP 539 | END-EXEC. 540 | 541 | 000-ALARM. 542 | 543 | EXEC CICS SEND CONTROL 544 | FREEKB 545 | ALARM 546 | END-EXEC. 547 | 548 | COPY SLICKNUM. 549 | -------------------------------------------------------------------------------- /sample/SLICKP2.cbl: -------------------------------------------------------------------------------- 1 | CBL XOPTS(COBOL2) 2 | IDENTIFICATION DIVISION. 3 | PROGRAM-ID. SLICKP2. 4 | AUTHOR. Ira M. Slick. 5 | ****************************************************************** 6 | *DESCRIPTION: List Accounts * 7 | ****************************************************************** 8 | ENVIRONMENT DIVISION. 9 | CONFIGURATION SECTION. 10 | SOURCE-COMPUTER. IBM-PC. 11 | OBJECT-COMPUTER. IBM-PC. 12 | DATA DIVISION. 13 | WORKING-STORAGE SECTION. 14 | 15 | COPY SLICKCOM. 16 | 17 | COPY SLICKM2. 18 | 19 | COPY DFHAID. 20 | 21 | COPY ACCTFILE. 22 | 23 | 01 SCREEN-BUFFER. 24 | 03 SCREEN-LINE-1. 25 | 05 SCR-ACCOUNT-ID PIC 9(06). 26 | 05 FILLER PIC X(02) VALUE SPACE. 27 | 05 SCR-NAME-LAST PIC X(16). 28 | 05 FILLER PIC X(01) VALUE SPACE. 29 | 05 SCR-NAME-FIRST PIC X(16). 30 | 05 FILLER PIC X(01) VALUE SPACE. 31 | 05 SCR-NAME-INITIAL PIC X(01). 32 | 05 FILLER PIC X(35) VALUE SPACE. 33 | 03 SCREEN-LINE-2. 34 | 05 FILLER PIC X(08) VALUE SPACE. 35 | 05 SCR-ADDRESS PIC X(64). 36 | 05 FILLER PIC X(06) VALUE SPACE. 37 | 03 SCREEN-LINE-3. 38 | 05 FILLER PIC X(08) VALUE SPACE. 39 | 05 SCR-CITY PIC X(24). 40 | 05 FILLER PIC X(01) VALUE SPACE. 41 | 05 SCR-STATE PIC X(02). 42 | 05 FILLER PIC X(03) VALUE SPACE. 43 | 05 SCR-ZIP PIC 9(05). 44 | 05 FILLER PIC X(01) VALUE SPACE. 45 | 05 SCR-ZIP-EX PIC 9(04). 46 | 05 FILLER PIC X(08) VALUE SPACE. 47 | 05 FILLER PIC X(01) VALUE '('. 48 | 05 SCR-TEL-1A PIC 9(03). 49 | 05 FILLER PIC X(01) VALUE ')'. 50 | 05 FILLER PIC X(01) VALUE SPACE. 51 | 05 SCR-TEL-1B PIC 9(03). 52 | 05 FILLER PIC X(01) VALUE '-'. 53 | 05 SCR-TEL-1C PIC 9(04). 54 | 05 FILLER PIC X(08) VALUE SPACE. 55 | 56 | 77 WORK-NUM PIC 9(03). 57 | 58 | 01 WS-EXIT PIC X(11) VALUE 59 | 'Slick ended'. 60 | 61 | LINKAGE SECTION. 62 | 63 | 01 DFHCOMMAREA. 64 | 03 FILLER PIC X(01) 65 | OCCURS 1 TO 4096 TIMES 66 | DEPENDING ON EIBCALEN. 67 | 68 | PROCEDURE DIVISION. 69 | 70 | 000-START-PROCESSING. 71 | 72 | MOVE DFHCOMMAREA TO SLICK-COMM. 73 | MOVE LOW-VALUES TO SLICKM2I. 74 | 75 | IF COMM-INIT 76 | PERFORM 000-INITIALIZATION 77 | ELSE 78 | PERFORM 000-RECEIVE-MAP. 79 | 80 | IF COMM-NEXT-TRAN = EIBTRNID 81 | PERFORM 000-SEND-MAP 82 | EXEC CICS RETURN 83 | TRANSID (COMM-NEXT-TRAN) 84 | COMMAREA (SLICK-COMM) 85 | END-EXEC 86 | 87 | ELSE 88 | SET COMM-INIT TO TRUE 89 | 90 | IF COMM-QUIT 91 | EXEC CICS SEND TEXT 92 | FROM (WS-EXIT) 93 | LENGTH (11) 94 | FREEKB 95 | ERASE 96 | END-EXEC 97 | 98 | EXEC CICS RETURN 99 | END-EXEC 100 | 101 | ELSE 102 | EXEC CICS RETURN 103 | TRANSID (COMM-NEXT-TRAN) 104 | COMMAREA (SLICK-COMM) 105 | IMMEDIATE 106 | END-EXEC. 107 | 108 | 000-INITIALIZATION. 109 | 110 | IF COMM-MAX-ACCOUNT-ID < COMM-MIN-ACCOUNT-ID 111 | MOVE 'No data available' TO COMM-MESSAGE 112 | SET COMM-MENU TO TRUE 113 | 114 | ELSE 115 | MOVE EIBTRNID TO COMM-NEXT-TRAN 116 | MOVE SPACE TO COMM-INIT-FLAG 117 | MOVE COMM-MIN-ACCOUNT-ID TO COMM-ACCOUNT-ID. 118 | 119 | 000-SEND-MAP. 120 | 121 | MOVE COMM-ACCOUNT-ID TO A-S-ACCOUNT-ID. 122 | MOVE COMM-DISPLAY-DATE TO M2DATEO. 123 | MOVE COMM-MESSAGE TO M2MSGO. 124 | MOVE SPACE TO COMM-MESSAGE. 125 | 126 | PERFORM 000-FILL-SCREEN 127 | VARYING I FROM 1 BY 1 128 | UNTIL I > 4. 129 | 130 | COMPUTE WORK-NUM = 131 | COMM-ACCOUNT-ID - COMM-MIN-ACCOUNT-ID + 1. 132 | MOVE WORK-NUM TO M2FROMO. 133 | 134 | COMPUTE WORK-NUM = 135 | COMM-MAX-ACCOUNT-ID - COMM-MIN-ACCOUNT-ID + 1. 136 | MOVE WORK-NUM TO M2OFO. 137 | 138 | EXEC CICS SEND 139 | MAP ('SLICKM2') 140 | CURSOR 141 | ERASE 142 | END-EXEC. 143 | 144 | 000-FILL-SCREEN. 145 | 146 | IF A-S-ACCOUNT-ID > COMM-MAX-ACCOUNT-ID 147 | PERFORM 000-BLANK-ENTRY 148 | 149 | ELSE 150 | 151 | COMPUTE WORK-NUM = 152 | A-S-ACCOUNT-ID - COMM-MIN-ACCOUNT-ID + 1 153 | MOVE WORK-NUM TO M2TOO 154 | 155 | EXEC CICS READ 156 | FILE ('ACCTFILE') 157 | INTO (ACCOUNT-STATISTICS-RECORD) 158 | RIDFLD (A-S-KEY) 159 | LENGTH (ACCTFILE-LENGTH) 160 | KEYLENGTH (ACCTFILE-KEYLENGTH) 161 | RESP (ACCTFILE-RESP) 162 | RESP2 (ACCTFILE-RESP2) 163 | END-EXEC 164 | 165 | IF ACCTFILE-RESP = DFHRESP(NORMAL) 166 | PERFORM 000-FILL-ENTRY 167 | 168 | ELSE 169 | PERFORM 000-BLANK-ENTRY. 170 | 171 | ADD 1 TO A-S-ACCOUNT-ID. 172 | 173 | 000-FILL-ENTRY. 174 | 175 | MOVE A-S-ADDRESS TO SCR-ADDRESS. 176 | MOVE A-S-CITY TO SCR-CITY. 177 | MOVE A-S-STATE TO SCR-STATE. 178 | MOVE A-S-ZIP TO SCR-ZIP. 179 | MOVE A-S-ZIP-EX TO SCR-ZIP-EX. 180 | MOVE A-S-TEL-1A TO SCR-TEL-1A. 181 | MOVE A-S-TEL-1B TO SCR-TEL-1B. 182 | MOVE A-S-TEL-1C TO SCR-TEL-1C. 183 | MOVE A-S-ACCOUNT-ID TO SCR-ACCOUNT-ID. 184 | MOVE A-S-NAME-LAST TO SCR-NAME-LAST. 185 | MOVE A-S-NAME-FIRST TO SCR-NAME-FIRST. 186 | MOVE A-S-NAME-INITIAL TO SCR-NAME-INITIAL. 187 | 188 | IF I = 1 189 | MOVE SCREEN-LINE-1 TO M2A1L1O 190 | MOVE SCREEN-LINE-2 TO M2A1L2O 191 | MOVE SCREEN-LINE-3 TO M2A1L3O 192 | ELSE 193 | IF I = 2 194 | MOVE SCREEN-LINE-1 TO M2A2L1O 195 | MOVE SCREEN-LINE-2 TO M2A2L2O 196 | MOVE SCREEN-LINE-3 TO M2A2L3O 197 | ELSE 198 | IF I = 3 199 | MOVE SCREEN-LINE-1 TO M2A3L1O 200 | MOVE SCREEN-LINE-2 TO M2A3L2O 201 | MOVE SCREEN-LINE-3 TO M2A3L3O 202 | ELSE 203 | IF I = 4 204 | MOVE SCREEN-LINE-1 TO M2A4L1O 205 | MOVE SCREEN-LINE-2 TO M2A4L2O 206 | MOVE SCREEN-LINE-3 TO M2A4L3O. 207 | 208 | 000-BLANK-ENTRY. 209 | 210 | MOVE SPACE TO SCREEN-LINE-1. 211 | 212 | IF A-S-ACCOUNT-ID NOT > COMM-MAX-ACCOUNT-ID 213 | MOVE A-S-ACCOUNT-ID TO SCR-ACCOUNT-ID 214 | MOVE 'Unavailable' TO SCR-NAME-LAST. 215 | 216 | IF I = 1 217 | MOVE SCREEN-LINE-1 TO M2A1L1O 218 | MOVE SPACE TO M2A1L2O 219 | MOVE SPACE TO M2A1L3O 220 | ELSE 221 | IF I = 2 222 | MOVE SCREEN-LINE-1 TO M2A2L1O 223 | MOVE SPACE TO M2A2L2O 224 | MOVE SPACE TO M2A2L3O 225 | ELSE 226 | IF I = 3 227 | MOVE SCREEN-LINE-1 TO M2A3L1O 228 | MOVE SPACE TO M2A3L2O 229 | MOVE SPACE TO M2A3L3O 230 | ELSE 231 | IF I = 4 232 | MOVE SCREEN-LINE-1 TO M2A4L1O 233 | MOVE SPACE TO M2A4L2O 234 | MOVE SPACE TO M2A4L3O. 235 | 236 | 000-RECEIVE-MAP. 237 | 238 | IF EIBAID = DFHPF11 239 | SET COMM-MENU TO TRUE 240 | ELSE 241 | IF EIBAID = DFHPF12 242 | OR EIBAID = DFHPF24 243 | SET COMM-QUIT TO TRUE 244 | ELSE 245 | PERFORM 000-SCROLL. 246 | 247 | 000-SCROLL. 248 | 249 | IF EIBAID = DFHENTER 250 | NEXT SENTENCE 251 | ELSE 252 | IF EIBAID = DFHPF1 253 | MOVE 1001 TO COMM-ACCOUNT-ID 254 | ELSE 255 | IF EIBAID = DFHPF2 256 | SUBTRACT 3 FROM COMM-MAX-ACCOUNT-ID 257 | GIVING COMM-ACCOUNT-ID 258 | ELSE 259 | IF EIBAID = DFHPF7 260 | SUBTRACT 4 FROM COMM-ACCOUNT-ID 261 | ELSE 262 | IF EIBAID = DFHPF8 263 | ADD 4 TO COMM-ACCOUNT-ID 264 | ELSE 265 | PERFORM 000-ALARM. 266 | 267 | IF COMM-ACCOUNT-ID > COMM-MAX-ACCOUNT-ID 268 | MOVE COMM-MAX-ACCOUNT-ID TO COMM-ACCOUNT-ID 269 | ELSE 270 | IF COMM-ACCOUNT-ID < 1001 271 | MOVE 1001 TO COMM-ACCOUNT-ID. 272 | 273 | 000-ALARM. 274 | 275 | EXEC CICS SEND CONTROL 276 | FREEKB 277 | ALARM 278 | END-EXEC. 279 | 280 | 281 | 282 | 283 | 284 | -------------------------------------------------------------------------------- /sample/SLICKP3.cbl: -------------------------------------------------------------------------------- 1 | CBL XOPTS(COBOL2) 2 | IDENTIFICATION DIVISION. 3 | PROGRAM-ID. SLICKP3. 4 | AUTHOR. Ira M. Slick. 5 | ****************************************************************** 6 | *DESCRIPTION: Update Account * 7 | ****************************************************************** 8 | ENVIRONMENT DIVISION. 9 | CONFIGURATION SECTION. 10 | SOURCE-COMPUTER. IBM-PC. 11 | OBJECT-COMPUTER. IBM-PC. 12 | DATA DIVISION. 13 | WORKING-STORAGE SECTION. 14 | 15 | COPY SLICKCOM. 16 | 17 | COPY SLICKM3. 18 | 19 | COPY DFHAID. 20 | 21 | COPY DFHBMSCA. 22 | 23 | COPY ACCTFILE. 24 | 25 | 01 WS-MAP-FIELDS. 26 | 03 WS-NAME-LAST PIC X(16) VALUE SPACE. 27 | 03 WS-NAME-FIRST PIC X(16) VALUE SPACE. 28 | 03 WS-NAME-INITIAL PIC X(01) VALUE SPACE. 29 | 03 WS-ADDRESS PIC X(64) VALUE SPACE. 30 | 03 WS-CITY PIC X(24) VALUE SPACE. 31 | 03 WS-STATE PIC X(02) VALUE SPACE. 32 | 03 WS-ZIP PIC 9(05) VALUE ZERO. 33 | 03 WS-ZIP-EX PIC 9(04) VALUE ZERO. 34 | 03 WS-TEL-1A PIC 9(03) VALUE ZERO. 35 | 03 WS-TEL-1B PIC 9(03) VALUE ZERO. 36 | 03 WS-TEL-1C PIC 9(04) VALUE ZERO. 37 | 03 WS-TEL-2A PIC 9(03) VALUE ZERO. 38 | 03 WS-TEL-2B PIC 9(03) VALUE ZERO. 39 | 03 WS-TEL-2C PIC 9(04) VALUE ZERO. 40 | 03 WS-SIZE-OF-HOME PIC 9(04) VALUE ZERO. 41 | 03 WS-SIZE-OF-TANK PIC 9(04) VALUE ZERO. 42 | 03 WS-UNIT-PRICE PIC 9(05) VALUE ZERO. 43 | 03 WS-ESTIMATED-USAGE PIC 9(04) VALUE ZERO. 44 | 03 WS-ESTIMATED-COST PIC 9(08) VALUE ZERO. 45 | 03 WS-BUDGET-AMOUNT PIC 9(08) VALUE ZERO. 46 | 03 WS-END-OF-CONTRACT. 47 | 05 WS-END-YY PIC 9(02) VALUE ZERO. 48 | 88 ACCOUNT-ACTIVE VALUE ZERO. 49 | 05 WS-END-MM PIC 9(02) VALUE ZERO. 50 | 05 WS-END-DD PIC 9(02) VALUE ZERO. 51 | 03 WS-LAST-AID PIC X(01) VALUE SPACE. 52 | 53 | 01 WS-EXIT PIC X(11) VALUE 54 | 'Slick ended'. 55 | 56 | LINKAGE SECTION. 57 | 58 | 01 DFHCOMMAREA. 59 | 03 FILLER PIC X(01) 60 | OCCURS 1 TO 4096 TIMES 61 | DEPENDING ON EIBCALEN. 62 | 63 | PROCEDURE DIVISION. 64 | 65 | 000-START-PROCESSING. 66 | 67 | MOVE DFHCOMMAREA TO SLICK-COMM. 68 | MOVE LOW-VALUES TO SLICKM3I. 69 | 70 | IF COMM-INIT 71 | OR COMM-RESUME 72 | PERFORM 000-INITIALIZATION 73 | 74 | ELSE 75 | MOVE COMM-SAVE TO WS-MAP-FIELDS 76 | PERFORM 000-RECEIVE-MAP. 77 | 78 | MOVE WS-MAP-FIELDS TO COMM-SAVE. 79 | 80 | IF COMM-NEXT-TRAN = EIBTRNID 81 | PERFORM 000-SEND-MAP 82 | 83 | EXEC CICS RETURN 84 | TRANSID (COMM-NEXT-TRAN) 85 | COMMAREA (SLICK-COMM) 86 | END-EXEC 87 | 88 | ELSE 89 | SET COMM-INIT TO TRUE 90 | 91 | IF COMM-QUIT 92 | EXEC CICS SEND TEXT 93 | FROM (WS-EXIT) 94 | LENGTH (11) 95 | FREEKB 96 | ERASE 97 | END-EXEC 98 | 99 | EXEC CICS RETURN 100 | END-EXEC 101 | 102 | ELSE 103 | EXEC CICS RETURN 104 | TRANSID (COMM-NEXT-TRAN) 105 | COMMAREA (SLICK-COMM) 106 | IMMEDIATE 107 | END-EXEC. 108 | 109 | 000-INITIALIZATION. 110 | 111 | IF COMM-INIT 112 | PERFORM 000-READ-STATISTICS 113 | ELSE 114 | MOVE COMM-SAVE TO WS-MAP-FIELDS. 115 | 116 | MOVE EIBTRNID TO COMM-NEXT-TRAN. 117 | MOVE SPACE TO COMM-INIT-FLAG. 118 | 119 | PERFORM 000-INITIALIZE-MAP-FIELDS. 120 | 121 | 000-READ-STATISTICS. 122 | 123 | MOVE COMM-ACCOUNT-ID TO A-S-ACCOUNT-ID. 124 | 125 | EXEC CICS READ 126 | FILE ('ACCTFILE') 127 | INTO (ACCOUNT-STATISTICS-RECORD) 128 | RIDFLD (A-S-KEY) 129 | LENGTH (ACCTFILE-LENGTH) 130 | KEYLENGTH (ACCTFILE-KEYLENGTH) 131 | RESP (ACCTFILE-RESP) 132 | RESP2 (ACCTFILE-RESP2) 133 | END-EXEC. 134 | 135 | IF ACCTFILE-RESP = DFHRESP(NORMAL) 136 | MOVE A-S-NAME-LAST TO WS-NAME-LAST 137 | MOVE A-S-NAME-FIRST TO WS-NAME-FIRST 138 | MOVE A-S-NAME-INITIAL TO WS-NAME-INITIAL 139 | MOVE A-S-ADDRESS TO WS-ADDRESS 140 | MOVE A-S-CITY TO WS-CITY 141 | MOVE A-S-STATE TO WS-STATE 142 | MOVE A-S-ZIP TO WS-ZIP 143 | MOVE A-S-ZIP-EX TO WS-ZIP-EX 144 | MOVE A-S-TEL-1A TO WS-TEL-1A 145 | MOVE A-S-TEL-1B TO WS-TEL-1B 146 | MOVE A-S-TEL-1C TO WS-TEL-1C 147 | MOVE A-S-TEL-2A TO WS-TEL-2A 148 | MOVE A-S-TEL-2B TO WS-TEL-2B 149 | MOVE A-S-TEL-2C TO WS-TEL-2C 150 | MOVE A-S-SIZE-OF-TANK TO WS-SIZE-OF-TANK 151 | MOVE A-S-SIZE-OF-HOME TO WS-SIZE-OF-HOME 152 | MOVE A-S-ESTIMATED-USAGE TO WS-ESTIMATED-USAGE 153 | MOVE A-S-UNIT-PRICE TO WS-UNIT-PRICE 154 | MOVE A-S-ESTIMATED-COST TO WS-ESTIMATED-COST 155 | MOVE A-S-BUDGET-AMOUNT TO WS-BUDGET-AMOUNT 156 | MOVE A-S-END-OF-CONTRACT TO WS-END-OF-CONTRACT 157 | 158 | ELSE 159 | MOVE 'Error reading account file.' 160 | TO M3MSGO 161 | SET COMM-MENU TO TRUE. 162 | 163 | 000-INITIALIZE-MAP-FIELDS. 164 | 165 | MOVE WS-NAME-LAST TO M3LASTO. 166 | MOVE WS-NAME-FIRST TO M3FIRSTO. 167 | MOVE WS-NAME-INITIAL TO M3INITO. 168 | MOVE WS-ADDRESS TO M3ADDRO. 169 | MOVE WS-CITY TO M3CITYO. 170 | MOVE WS-STATE TO M3STATEO. 171 | MOVE WS-ZIP TO M3ZIPO. 172 | MOVE WS-ZIP-EX TO M3ZIPXO. 173 | MOVE WS-TEL-1A TO M3TEL1AO. 174 | MOVE WS-TEL-1B TO M3TEL1BO. 175 | MOVE WS-TEL-1C TO M3TEL1CO. 176 | MOVE WS-TEL-2A TO M3TEL2AO. 177 | MOVE WS-TEL-2B TO M3TEL2BO. 178 | MOVE WS-TEL-2C TO M3TEL2CO. 179 | MOVE WS-SIZE-OF-TANK TO M3TANKO. 180 | MOVE WS-SIZE-OF-HOME TO M3HOMEO. 181 | MOVE WS-ESTIMATED-USAGE TO M3USAGEO. 182 | MOVE WS-UNIT-PRICE TO NUM-5. 183 | MOVE DOLLARS-5 TO D-5. 184 | MOVE CENTS-5 TO C-5. 185 | MOVE DC-5 TO M3UNITO. 186 | MOVE WS-ESTIMATED-COST TO NUM-8. 187 | MOVE DOLLARS-8 TO D-8. 188 | MOVE CENTS-8 TO C-8. 189 | MOVE DC-8 TO M3COSTO. 190 | MOVE WS-BUDGET-AMOUNT TO NUM-8. 191 | MOVE DOLLARS-8 TO D-8. 192 | MOVE CENTS-8 TO C-8. 193 | MOVE DC-8 TO M3PAYO. 194 | 195 | 000-SEND-MAP. 196 | 197 | MOVE COMM-DISPLAY-DATE TO M3DATEO. 198 | MOVE COMM-ACCOUNT-ID TO M3IDO. 199 | MOVE COMM-MESSAGE TO M3MSGO. 200 | MOVE SPACE TO COMM-MESSAGE. 201 | 202 | IF ACCOUNT-ACTIVE 203 | MOVE 'Active' TO M3STATO 204 | MOVE 'Disable' TO M3PF5O 205 | MOVE DFHBMASB TO M3PF2A 206 | MOVE DFHBMASB TO M3PF4A 207 | ELSE 208 | MOVE 'Disabled' TO M3STATO 209 | MOVE 'Enable' TO M3PF5O 210 | MOVE DFHBMDAR TO M3PF2A 211 | MOVE DFHBMDAR TO M3PF4A. 212 | 213 | IF NOT BAD-DATA 214 | MOVE -1 TO M3MSGL. 215 | 216 | EXEC CICS SEND 217 | MAP ('SLICKM3') 218 | CURSOR 219 | ERASE 220 | END-EXEC. 221 | 222 | IF M3MSGO NOT = SPACE 223 | PERFORM 000-ALARM. 224 | 225 | 000-RECEIVE-MAP. 226 | 227 | IF EIBAID = DFHPF11 228 | SET COMM-MENU TO TRUE 229 | ELSE 230 | IF EIBAID = DFHPF12 231 | OR EIBAID = DFHPF24 232 | SET COMM-QUIT TO TRUE 233 | ELSE 234 | PERFORM 000-PROCESS-FIELDS 235 | MOVE EIBAID TO WS-LAST-AID. 236 | 237 | 000-PROCESS-FIELDS. 238 | 239 | EXEC CICS RECEIVE 240 | MAP ('SLICKM3') 241 | RESP (COMM-RESP) 242 | END-EXEC. 243 | 244 | PERFORM 000-VALIDATE-MAP-FIELDS. 245 | SET MAP-RECEIVED TO TRUE. 246 | 247 | IF EIBAID = DFHENTER 248 | NEXT SENTENCE 249 | ELSE 250 | IF EIBAID NOT = DFHPF1 AND DFHPF2 AND DFHPF3 251 | AND DFHPF4 AND DFHPF5 252 | MOVE 'Invalid Key.' 253 | TO COMM-MESSAGE 254 | ELSE 255 | IF BAD-DATA 256 | MOVE 'Enter required field(s).' 257 | TO COMM-MESSAGE 258 | ELSE 259 | PERFORM 000-PROCESS-REQUEST. 260 | 261 | 000-VALIDATE-MAP-FIELDS. 262 | 263 | * Unit Cost (Required) 264 | IF M3UNITL = ZERO 265 | MOVE WS-UNIT-PRICE TO NUM-5 266 | MOVE DOLLARS-5 TO D-5 267 | MOVE CENTS-5 TO C-5 268 | MOVE DC-5 TO M3UNITI 269 | ELSE 270 | SET MAP-CHANGED TO TRUE 271 | MOVE 5 TO WS-FIELD-SIZE 272 | MOVE M3UNITI TO CH-ARRAY 273 | PERFORM 000-MONEY-FIELD 274 | MOVE CH-ARRAY TO WS-UNIT-PRICE 275 | MOVE DC-5 TO M3UNITI. 276 | 277 | IF WS-UNIT-PRICE = ZERO 278 | SET BAD-DATA TO TRUE 279 | MOVE -1 TO M3UNITL. 280 | 281 | * Tank Size (Required) 282 | IF M3TANKL = ZERO 283 | MOVE WS-SIZE-OF-TANK TO M3TANKI 284 | ELSE 285 | SET MAP-CHANGED TO TRUE 286 | MOVE 4 TO WS-FIELD-SIZE 287 | MOVE M3TANKI TO CH-ARRAY 288 | PERFORM 000-NUM-FIELD 289 | MOVE CH-ARRAY TO WS-SIZE-OF-TANK 290 | MOVE CH-ARRAY TO M3TANKI. 291 | 292 | IF WS-SIZE-OF-TANK = ZERO 293 | SET BAD-DATA TO TRUE 294 | MOVE -1 TO M3TANKL. 295 | 296 | * Estimated Usage (Required) 297 | IF M3USAGEL = ZERO 298 | MOVE WS-ESTIMATED-USAGE TO M3USAGEI 299 | ELSE 300 | SET MAP-CHANGED TO TRUE 301 | MOVE 4 TO WS-FIELD-SIZE 302 | MOVE M3USAGEI TO CH-ARRAY 303 | PERFORM 000-NUM-FIELD 304 | MOVE CH-ARRAY TO WS-ESTIMATED-USAGE 305 | MOVE CH-ARRAY TO M3USAGEI. 306 | 307 | IF WS-ESTIMATED-USAGE = ZERO 308 | SET BAD-DATA TO TRUE 309 | MOVE -1 TO M3USAGEL. 310 | 311 | * Home Size (Required) 312 | IF M3HOMEL = ZERO 313 | MOVE WS-SIZE-OF-HOME TO M3HOMEI 314 | ELSE 315 | SET MAP-CHANGED TO TRUE 316 | MOVE 4 TO WS-FIELD-SIZE 317 | MOVE M3HOMEI TO CH-ARRAY 318 | PERFORM 000-NUM-FIELD 319 | MOVE CH-ARRAY TO WS-SIZE-OF-HOME 320 | MOVE CH-ARRAY TO M3HOMEI. 321 | 322 | IF WS-SIZE-OF-HOME = ZERO 323 | SET BAD-DATA TO TRUE 324 | MOVE -1 TO M3HOMEL. 325 | 326 | * Office Telephone (Optional) 327 | IF M3TEL2CL = ZERO 328 | MOVE WS-TEL-2C TO M3TEL2CI 329 | ELSE 330 | SET MAP-CHANGED TO TRUE 331 | MOVE 3 TO WS-FIELD-SIZE 332 | MOVE M3TEL2CI TO CH-ARRAY 333 | PERFORM 000-NUM-FIELD 334 | MOVE CH-ARRAY TO WS-TEL-2C 335 | MOVE CH-ARRAY TO M3TEL2CI. 336 | 337 | * Office Telephone Exchange (Optional) 338 | IF M3TEL2BL = ZERO 339 | MOVE WS-TEL-2B TO M3TEL2BI 340 | ELSE 341 | SET MAP-CHANGED TO TRUE 342 | MOVE 3 TO WS-FIELD-SIZE 343 | MOVE M3TEL2BI TO CH-ARRAY 344 | PERFORM 000-NUM-FIELD 345 | MOVE CH-ARRAY TO WS-TEL-2B 346 | MOVE CH-ARRAY TO M3TEL2BI. 347 | 348 | * Office Telephone Area Code (Optional) 349 | IF M3TEL2AL = ZERO 350 | MOVE WS-TEL-2A TO M3TEL2AI 351 | ELSE 352 | SET MAP-CHANGED TO TRUE 353 | MOVE 3 TO WS-FIELD-SIZE 354 | MOVE M3TEL2AI TO CH-ARRAY 355 | PERFORM 000-NUM-FIELD 356 | MOVE CH-ARRAY TO WS-TEL-2A 357 | MOVE CH-ARRAY TO M3TEL2AI. 358 | 359 | * Home Telephone (Required) 360 | IF M3TEL1CL = ZERO 361 | MOVE WS-TEL-1C TO M3TEL1CI 362 | ELSE 363 | SET MAP-CHANGED TO TRUE 364 | MOVE 4 TO WS-FIELD-SIZE 365 | MOVE M3TEL1CI TO CH-ARRAY 366 | PERFORM 000-NUM-FIELD 367 | MOVE CH-ARRAY TO WS-TEL-1C 368 | MOVE CH-ARRAY TO M3TEL1CI. 369 | 370 | * Home Telephone Exchange (Required) 371 | IF M3TEL1BL = ZERO 372 | MOVE WS-TEL-1B TO M3TEL1BI 373 | ELSE 374 | SET MAP-CHANGED TO TRUE 375 | MOVE 3 TO WS-FIELD-SIZE 376 | MOVE M3TEL1BI TO CH-ARRAY 377 | PERFORM 000-NUM-FIELD 378 | MOVE CH-ARRAY TO WS-TEL-1B 379 | MOVE CH-ARRAY TO M3TEL1BI. 380 | 381 | IF WS-TEL-1B = ZERO 382 | SET BAD-DATA TO TRUE 383 | MOVE -1 TO M3TEL1BL. 384 | 385 | * Home Telephone Area Code (Required) 386 | IF M3TEL1AL = ZERO 387 | MOVE WS-TEL-1A TO M3TEL1AI 388 | ELSE 389 | SET MAP-CHANGED TO TRUE 390 | MOVE 3 TO WS-FIELD-SIZE 391 | MOVE M3TEL1AI TO CH-ARRAY 392 | PERFORM 000-NUM-FIELD 393 | MOVE CH-ARRAY TO WS-TEL-1A 394 | MOVE CH-ARRAY TO M3TEL1AI. 395 | 396 | IF WS-TEL-1A = ZERO 397 | SET BAD-DATA TO TRUE 398 | MOVE -1 TO M3TEL1AL. 399 | 400 | * Extended Zip Code (Optional) 401 | IF M3ZIPXL = ZERO 402 | MOVE WS-ZIP-EX TO M3ZIPXI 403 | ELSE 404 | SET MAP-CHANGED TO TRUE 405 | MOVE 4 TO WS-FIELD-SIZE 406 | MOVE M3ZIPXI TO CH-ARRAY 407 | PERFORM 000-NUM-FIELD 408 | MOVE CH-ARRAY TO WS-ZIP-EX 409 | MOVE CH-ARRAY TO M3ZIPXI. 410 | 411 | * Zip Code (Required) 412 | IF M3ZIPL = ZERO 413 | MOVE WS-ZIP TO M3ZIPI 414 | ELSE 415 | SET MAP-CHANGED TO TRUE 416 | MOVE 5 TO WS-FIELD-SIZE 417 | MOVE M3ZIPI TO CH-ARRAY 418 | PERFORM 000-NUM-FIELD 419 | MOVE CH-ARRAY TO WS-ZIP 420 | MOVE CH-ARRAY TO M3ZIPI. 421 | 422 | IF WS-ZIP = ZERO 423 | SET BAD-DATA TO TRUE 424 | MOVE -1 TO M3ZIPL. 425 | 426 | * State Name (Required) 427 | IF M3STATEL = ZERO 428 | MOVE WS-STATE TO M3STATEI 429 | ELSE 430 | INSPECT M3STATEI REPLACING ALL '_' BY ' ' 431 | SET MAP-CHANGED TO TRUE 432 | MOVE M3STATEI TO WS-STATE. 433 | 434 | IF WS-STATE = SPACE 435 | SET BAD-DATA TO TRUE 436 | MOVE ALL '_' TO M3STATEI 437 | MOVE -1 TO M3STATEL. 438 | 439 | * City (Required) 440 | IF M3CITYL = ZERO 441 | MOVE WS-CITY TO M3CITYI 442 | ELSE 443 | INSPECT M3CITYI REPLACING ALL '_' BY ' ' 444 | SET MAP-CHANGED TO TRUE 445 | MOVE M3CITYI TO WS-CITY. 446 | 447 | IF WS-CITY = SPACE 448 | SET BAD-DATA TO TRUE 449 | MOVE ALL '_' TO M3CITYI 450 | MOVE -1 TO M3CITYL. 451 | 452 | * Address (Required) 453 | IF M3ADDRL = ZERO 454 | MOVE WS-ADDRESS TO M3ADDRI 455 | ELSE 456 | INSPECT M3ADDRI REPLACING ALL '_' BY ' ' 457 | SET MAP-CHANGED TO TRUE 458 | MOVE M3ADDRI TO WS-ADDRESS. 459 | 460 | IF WS-ADDRESS = SPACE 461 | SET BAD-DATA TO TRUE 462 | MOVE ALL '_' TO M3ADDRI 463 | MOVE -1 TO M3ADDRL. 464 | 465 | * Middle Initial (Optional) 466 | IF M3INITL = ZERO 467 | MOVE WS-NAME-INITIAL TO M3INITI 468 | ELSE 469 | INSPECT M3INITI REPLACING ALL '_' BY ' ' 470 | SET MAP-CHANGED TO TRUE 471 | MOVE M3INITI TO WS-NAME-INITIAL. 472 | 473 | IF WS-NAME-INITIAL = SPACE 474 | MOVE ALL '_' TO M3INITI. 475 | 476 | * First Name (Required) 477 | IF M3FIRSTL = ZERO 478 | MOVE WS-NAME-FIRST TO M3FIRSTI 479 | ELSE 480 | INSPECT M3FIRSTI REPLACING ALL '_' BY ' ' 481 | SET MAP-CHANGED TO TRUE 482 | MOVE M3FIRSTI TO WS-NAME-FIRST. 483 | 484 | IF WS-NAME-FIRST = SPACE 485 | SET BAD-DATA TO TRUE 486 | MOVE ALL '_' TO M3FIRSTI 487 | MOVE -1 TO M3FIRSTL. 488 | 489 | * Last Name (Required) 490 | IF M3LASTL = ZERO 491 | MOVE WS-NAME-LAST TO M3LASTI 492 | ELSE 493 | INSPECT M3LASTI REPLACING ALL '_' BY ' ' 494 | SET MAP-CHANGED TO TRUE 495 | MOVE M3LASTI TO WS-NAME-LAST. 496 | 497 | IF WS-NAME-LAST = SPACE 498 | SET BAD-DATA TO TRUE 499 | MOVE ALL '_' TO M3LASTI 500 | MOVE -1 TO M3LASTL. 501 | 502 | * Adjust the Estimated Usage if the Size of Home has changed 503 | IF M3HOMEL > ZERO 504 | COMPUTE WS-ESTIMATED-USAGE = (WS-SIZE-OF-HOME * 2) / 3 505 | MOVE WS-ESTIMATED-USAGE TO M3USAGEI 506 | MOVE ZERO TO M3USAGEL. 507 | 508 | * Estimated Cost (Calculated) 509 | COMPUTE WS-ESTIMATED-COST = 510 | (WS-ESTIMATED-USAGE * WS-UNIT-PRICE). 511 | 512 | MOVE WS-ESTIMATED-COST TO NUM-8. 513 | MOVE DOLLARS-8 TO D-8. 514 | MOVE CENTS-8 TO C-8. 515 | MOVE DC-8 TO M3COSTO. 516 | 517 | * Budget Amount (Calculated) 518 | COMPUTE WS-BUDGET-AMOUNT = 519 | ((((WS-ESTIMATED-COST / 12) + 50) / 1000) * 1000). 520 | 521 | MOVE WS-BUDGET-AMOUNT TO NUM-8. 522 | MOVE DOLLARS-8 TO D-8. 523 | MOVE CENTS-8 TO C-8. 524 | MOVE DC-8 TO M3PAYO. 525 | 526 | 000-PROCESS-REQUEST. 527 | 528 | IF EIBAID = DFHPF1 529 | IF WS-LAST-AID NOT = DFHPF1 530 | OR MAP-CHANGED 531 | MOVE 'Hit PF1 to confirm update.' 532 | TO COMM-MESSAGE 533 | ELSE 534 | PERFORM 000-UPDATE-ACCOUNT 535 | ELSE 536 | IF EIBAID = DFHPF2 537 | IF ACCOUNT-ACTIVE 538 | SET COMM-UPDATE-DELIVERY TO TRUE 539 | SET COMM-INIT TO TRUE 540 | ELSE 541 | MOVE 'Invalid key for disabled account.' 542 | TO COMM-MESSAGE 543 | ELSE 544 | IF EIBAID = DFHPF3 545 | SET COMM-UPDATE-PAYMENT TO TRUE 546 | SET COMM-INIT TO TRUE 547 | ELSE 548 | IF EIBAID = DFHPF4 549 | IF ACCOUNT-ACTIVE 550 | SET COMM-UPDATE-SERVICE TO TRUE 551 | SET COMM-INIT TO TRUE 552 | ELSE 553 | MOVE 'Invalid key for disabled account.' 554 | TO COMM-MESSAGE 555 | ELSE 556 | IF EIBAID = DFHPF5 557 | IF ACCOUNT-ACTIVE 558 | MOVE COMM-TRAN-DATE TO WS-END-OF-CONTRACT 559 | ELSE 560 | MOVE ZERO TO WS-END-OF-CONTRACT. 561 | 562 | 000-UPDATE-ACCOUNT. 563 | 564 | MOVE COMM-ACCOUNT-ID TO A-S-ACCOUNT-ID. 565 | 566 | EXEC CICS READ 567 | FILE ('ACCTFILE') 568 | INTO (ACCOUNT-STATISTICS-RECORD) 569 | RIDFLD (A-S-KEY) 570 | LENGTH (ACCTFILE-LENGTH) 571 | KEYLENGTH (ACCTFILE-KEYLENGTH) 572 | RESP (ACCTFILE-RESP) 573 | RESP2 (ACCTFILE-RESP2) 574 | UPDATE 575 | END-EXEC. 576 | 577 | IF ACCTFILE-RESP NOT = DFHRESP(NORMAL) 578 | MOVE 'Error updating account file.' 579 | TO COMM-MESSAGE 580 | ELSE 581 | MOVE WS-NAME-LAST TO A-S-NAME-LAST 582 | MOVE WS-NAME-FIRST TO A-S-NAME-FIRST 583 | MOVE WS-NAME-INITIAL TO A-S-NAME-INITIAL 584 | MOVE WS-ADDRESS TO A-S-ADDRESS 585 | MOVE WS-CITY TO A-S-CITY 586 | MOVE WS-STATE TO A-S-STATE 587 | MOVE WS-ZIP TO A-S-ZIP 588 | MOVE WS-ZIP-EX TO A-S-ZIP-EX 589 | MOVE WS-TEL-1A TO A-S-TEL-1A 590 | MOVE WS-TEL-1B TO A-S-TEL-1B 591 | MOVE WS-TEL-1C TO A-S-TEL-1C 592 | MOVE WS-TEL-2A TO A-S-TEL-2A 593 | MOVE WS-TEL-2B TO A-S-TEL-2B 594 | MOVE WS-TEL-2C TO A-S-TEL-2C 595 | MOVE WS-SIZE-OF-TANK TO A-S-SIZE-OF-TANK 596 | MOVE WS-SIZE-OF-HOME TO A-S-SIZE-OF-HOME 597 | MOVE WS-UNIT-PRICE TO A-S-UNIT-PRICE 598 | MOVE WS-ESTIMATED-USAGE TO A-S-ESTIMATED-USAGE 599 | MOVE WS-ESTIMATED-COST TO A-S-ESTIMATED-COST 600 | MOVE WS-BUDGET-AMOUNT TO A-S-BUDGET-AMOUNT 601 | MOVE WS-END-OF-CONTRACT TO A-S-END-OF-CONTRACT 602 | 603 | EXEC CICS REWRITE 604 | FILE ('ACCTFILE') 605 | FROM (ACCOUNT-STATISTICS-RECORD) 606 | LENGTH (ACCTFILE-LENGTH) 607 | RESP (ACCTFILE-RESP) 608 | RESP2 (ACCTFILE-RESP2) 609 | END-EXEC 610 | 611 | IF ACCTFILE-RESP NOT = DFHRESP(NORMAL) 612 | MOVE ACCTFILE-RESP TO ERROR-RESP 613 | MOVE ACCTFILE-RESP2 TO ERROR-RESP2 614 | MOVE A-S-KEY TO ERROR-KEY 615 | MOVE 'Rewrite' TO ERROR-TYPE 616 | MOVE ERROR-MESSAGE TO COMM-MESSAGE 617 | ELSE 618 | MOVE 'Account updated.' 619 | TO COMM-MESSAGE. 620 | 621 | 000-ALARM. 622 | 623 | EXEC CICS SEND CONTROL 624 | FREEKB 625 | ALARM 626 | END-EXEC. 627 | 628 | COPY SLICKNUM. 629 | -------------------------------------------------------------------------------- /sample/SLICKP4.cbl: -------------------------------------------------------------------------------- 1 | CBL XOPTS(COBOL2) 2 | IDENTIFICATION DIVISION. 3 | PROGRAM-ID. SLICKP4. 4 | AUTHOR. Ira M. Slick. 5 | ****************************************************************** 6 | *DESCRIPTION: Account History * 7 | ****************************************************************** 8 | ENVIRONMENT DIVISION. 9 | CONFIGURATION SECTION. 10 | SOURCE-COMPUTER. IBM-PC. 11 | OBJECT-COMPUTER. IBM-PC. 12 | DATA DIVISION. 13 | WORKING-STORAGE SECTION. 14 | 15 | COPY SLICKCOM. 16 | 17 | COPY SLICKM4. 18 | 19 | COPY DFHAID. 20 | 21 | COPY ACCTFILE. 22 | 23 | 01 WS-MAP-FIELDS. 24 | 03 WS-FROM PIC S9(04) COMP VALUE ZERO. 25 | 03 WS-TO PIC 9(04) COMP VALUE ZERO. 26 | 03 WS-INDEX PIC 9(04) COMP VALUE ZERO. 27 | 03 WS-TABLE-ENTRIES PIC 9(04) COMP VALUE ZERO. 28 | 03 WS-TABLE-SIZE PIC 9(08) COMP VALUE ZERO. 29 | 03 WS-TABLE-POINTER USAGE IS POINTER. 30 | 31 | 01 WS-DELIVERY-ENTRY PIC 9(04) COMP VALUE ZERO. 32 | 01 WS-DELIVERY-RECORD PIC 9(04) COMP VALUE ZERO. 33 | 01 WS-DELIVERY-SUB PIC 9(04) COMP VALUE ZERO. 34 | 35 | 01 WS-PAYMENT-ENTRY PIC 9(04) COMP VALUE ZERO. 36 | 01 WS-PAYMENT-RECORD PIC 9(04) COMP VALUE ZERO. 37 | 01 WS-PAYMENT-SUB PIC 9(04) COMP VALUE ZERO. 38 | 39 | 01 WS-MAINTENANCE-ENTRY PIC 9(04) COMP VALUE ZERO. 40 | 01 WS-MAINTENANCE-RECORD PIC 9(04) COMP VALUE ZERO. 41 | 01 WS-MAINTENANCE-SUB PIC 9(04) COMP VALUE ZERO. 42 | 43 | 01 SCREEN-BUFFER PIC X(80) VALUE SPACE. 44 | 45 | 01 DELIVERY-MESSAGE. 46 | 03 D-M-MM PIC 9(02). 47 | 03 FILLER PIC X(01) VALUE '/'. 48 | 03 D-M-DD PIC 9(02). 49 | 03 FILLER PIC X(01) VALUE '/'. 50 | 03 D-M-YY PIC 9(02). 51 | 03 FILLER PIC X(03) VALUE SPACE. 52 | 03 D-M-EMPL PIC 9(04). 53 | 03 FILLER PIC X(03) VALUE SPACE. 54 | 03 FILLER PIC X(12) VALUE 55 | 'Delivery of '. 56 | 03 D-M-GALLONS PIC ZZZ9. 57 | 03 FILLER PIC X(12) VALUE 58 | ' gallons at '. 59 | 03 D-M-UNIT-PRICE PIC X(05). 60 | 03 FILLER PIC X(01) VALUE '.'. 61 | 62 | 01 PAYMENT-MESSAGE. 63 | 03 P-M-MM PIC 9(02). 64 | 03 FILLER PIC X(01) VALUE '/'. 65 | 03 P-M-DD PIC 9(02). 66 | 03 FILLER PIC X(01) VALUE '/'. 67 | 03 P-M-YY PIC 9(02). 68 | 03 FILLER PIC X(03) VALUE SPACE. 69 | 03 FILLER PIC X(04) VALUE 'n/a'. 70 | 03 FILLER PIC X(03) VALUE SPACE. 71 | 03 FILLER PIC X(11) VALUE 72 | 'Payment of '. 73 | 03 P-M-AMOUNT PIC X(08). 74 | 03 FILLER PIC X(10) VALUE 75 | ' received.'. 76 | 77 | 01 MAINTENANCE-MESSAGE. 78 | 03 M-M-MM PIC 9(02). 79 | 03 FILLER PIC X(01) VALUE '/'. 80 | 03 M-M-DD PIC 9(02). 81 | 03 FILLER PIC X(01) VALUE '/'. 82 | 03 M-M-YY PIC 9(02). 83 | 03 FILLER PIC X(03) VALUE SPACE. 84 | 03 M-M-EMPL PIC 9(04). 85 | 03 FILLER PIC X(03) VALUE SPACE. 86 | 03 FILLER PIC X(08) VALUE 87 | 'Service '. 88 | 03 M-M-SERVICE-CHARGE PIC X(40). 89 | 90 | 01 SERVICE-CHARGE-MESSAGE. 91 | 03 FILLER PIC X(13) VALUE 92 | '(a charge of '. 93 | 03 M-M-AMOUNT PIC X(08). 94 | 03 FILLER PIC X(14) VALUE 95 | ' was applied).'. 96 | 01 NO-CHARGE-MESSAGE. 97 | 03 FILLER PIC X(14) VALUE 98 | '(No charge)'. 99 | 100 | 01 TEMP-DATE. 101 | 03 TEMP-YY PIC 9(02). 102 | 03 TEMP-MM PIC 9(02). 103 | 03 TEMP-DD PIC 9(02). 104 | 105 | 01 WORK-NUM PIC 9(03). 106 | 107 | 01 WS-NULL PIC X(01) VALUE LOW-VALUE. 108 | 109 | 01 WS-EXIT PIC X(11) VALUE 110 | 'Slick ended'. 111 | 112 | LINKAGE SECTION. 113 | 114 | 01 DFHCOMMAREA. 115 | 03 FILLER PIC X(01) 116 | OCCURS 1 TO 4096 TIMES 117 | DEPENDING ON EIBCALEN. 118 | 119 | 01 HISTORY-TABLE. 120 | 03 HISTORY-ENTRY OCCURS 1 TO 1000 TIMES 121 | DEPENDING ON WS-TABLE-ENTRIES. 122 | 05 H-RECORD-TYPE PIC 9(02). 123 | 05 H-ENTRY PIC 9(04). 124 | 125 | PROCEDURE DIVISION. 126 | 127 | 000-START-PROCESSING. 128 | 129 | MOVE DFHCOMMAREA TO SLICK-COMM. 130 | MOVE LOW-VALUES TO SLICKM4I. 131 | 132 | IF COMM-INIT 133 | PERFORM 000-INITIALIZATION 134 | 135 | ELSE 136 | MOVE COMM-SAVE TO WS-MAP-FIELDS 137 | SET ADDRESS OF HISTORY-TABLE TO WS-TABLE-POINTER 138 | PERFORM 000-RECEIVE-MAP. 139 | 140 | IF COMM-NEXT-TRAN = EIBTRNID 141 | MOVE WS-MAP-FIELDS TO COMM-SAVE 142 | PERFORM 000-SEND-MAP 143 | 144 | EXEC CICS RETURN 145 | TRANSID (COMM-NEXT-TRAN) 146 | COMMAREA (SLICK-COMM) 147 | END-EXEC 148 | 149 | ELSE 150 | SET COMM-INIT TO TRUE 151 | 152 | IF COMM-QUIT 153 | EXEC CICS SEND TEXT 154 | FROM (WS-EXIT) 155 | LENGTH (11) 156 | FREEKB 157 | ERASE 158 | END-EXEC 159 | 160 | EXEC CICS RETURN 161 | END-EXEC 162 | 163 | ELSE 164 | EXEC CICS RETURN 165 | TRANSID (COMM-NEXT-TRAN) 166 | COMMAREA (SLICK-COMM) 167 | IMMEDIATE 168 | END-EXEC. 169 | 170 | 000-TERMINATION. 171 | 172 | IF WS-TABLE-POINTER NOT = NULL 173 | EXEC CICS FREEMAIN 174 | DATA (HISTORY-TABLE) 175 | RESP (COMM-RESP) 176 | RESP2 (COMM-RESP2) 177 | END-EXEC. 178 | 179 | 000-INITIALIZATION. 180 | 181 | MOVE EIBTRNID TO COMM-NEXT-TRAN. 182 | MOVE SPACE TO COMM-INIT-FLAG. 183 | 184 | MOVE COMM-ACCOUNT-ID TO A-S-ACCOUNT-ID. 185 | MOVE COMM-ACCOUNT-ID TO A-D-ACCOUNT-ID. 186 | MOVE COMM-ACCOUNT-ID TO A-P-ACCOUNT-ID. 187 | MOVE COMM-ACCOUNT-ID TO A-M-ACCOUNT-ID. 188 | MOVE 1 TO WS-FROM. 189 | 190 | EXEC CICS READ 191 | FILE ('ACCTFILE') 192 | INTO (ACCOUNT-STATISTICS-RECORD) 193 | RIDFLD (A-S-KEY) 194 | LENGTH (ACCTFILE-LENGTH) 195 | KEYLENGTH (ACCTFILE-KEYLENGTH) 196 | RESP (ACCTFILE-RESP) 197 | RESP2 (ACCTFILE-RESP2) 198 | END-EXEC. 199 | 200 | IF ACCTFILE-RESP = DFHRESP(NORMAL) 201 | PERFORM 000-BUILD-HISTORY-TABLE 202 | 203 | ELSE 204 | MOVE 'Error reading account file.' 205 | TO M4MSGO 206 | SET COMM-MENU TO TRUE. 207 | 208 | 000-BUILD-HISTORY-TABLE. 209 | 210 | MOVE A-S-DELIVERY-ENTRIES TO WS-DELIVERY-ENTRY. 211 | MOVE A-S-PAYMENT-ENTRIES TO WS-PAYMENT-ENTRY. 212 | MOVE A-S-MAINTENANCE-ENTRIES TO WS-MAINTENANCE-ENTRY. 213 | 214 | COMPUTE WS-TABLE-ENTRIES = A-S-DELIVERY-ENTRIES + 215 | A-S-PAYMENT-ENTRIES + 216 | A-S-MAINTENANCE-ENTRIES. 217 | 218 | MULTIPLY WS-TABLE-ENTRIES BY 6 GIVING WS-TABLE-SIZE. 219 | 220 | EXEC CICS GETMAIN 221 | SET (WS-TABLE-POINTER) 222 | LENGTH (WS-TABLE-SIZE) 223 | INITIMG (WS-NULL) 224 | SHARED 225 | RESP (COMM-RESP) 226 | RESP2 (COMM-RESP2) 227 | END-EXEC. 228 | 229 | SET ADDRESS OF HISTORY-TABLE TO WS-TABLE-POINTER. 230 | 231 | MOVE 9999 TO A-D-RECORD-NUMBER. 232 | MOVE 9999 TO A-P-RECORD-NUMBER. 233 | MOVE 9999 TO A-M-RECORD-NUMBER. 234 | 235 | IF COMM-RESP = DFHRESP(NORMAL) 236 | PERFORM 000-BUILD-HISTORY-ENTRY 237 | VARYING I FROM 1 BY 1 238 | UNTIL I > WS-TABLE-ENTRIES. 239 | 240 | 000-BUILD-HISTORY-ENTRY. 241 | 242 | PERFORM 000-GET-DELIVERY-ENTRY. 243 | PERFORM 000-GET-PAYMENT-ENTRY. 244 | PERFORM 000-GET-MAINTENANCE-ENTRY. 245 | 246 | Y2K MOVE A-D-DATE-OF-DELIVERY (WS-DELIVERY-SUB) 247 | Y2K TO Y2K-YYMMDD-1. 248 | Y2K PERFORM 000-Y2K-WINDOW-1. 249 | Y2K 250 | Y2K MOVE A-P-DATE-OF-PAYMENT (WS-PAYMENT-SUB) 251 | Y2K TO Y2K-YYMMDD-2. 252 | Y2K PERFORM 000-Y2K-WINDOW-2. 253 | Y2K 254 | Y2K MOVE A-M-DATE-OF-SERVICE (WS-MAINTENANCE-SUB) 255 | Y2K TO Y2K-YYMMDD-3. 256 | Y2K PERFORM 000-Y2K-WINDOW-3. 257 | 258 | Y2K * IF A-D-DATE-OF-DELIVERY (WS-DELIVERY-SUB) > 259 | Y2K * A-P-DATE-OF-PAYMENT (WS-PAYMENT-SUB) 260 | Y2K * AND A-D-DATE-OF-DELIVERY (WS-DELIVERY-SUB) > 261 | Y2K * A-M-DATE-OF-SERVICE (WS-MAINTENANCE-SUB) 262 | 263 | Y2K IF Y2K-DATE-1 > Y2K-DATE-2 264 | Y2K AND Y2K-DATE-1 > Y2K-DATE-3 265 | Y2K 266 | MOVE A-D-RECORD-TYPE TO H-RECORD-TYPE (I) 267 | MOVE WS-DELIVERY-ENTRY TO H-ENTRY (I) 268 | SUBTRACT 1 FROM WS-DELIVERY-ENTRY 269 | 270 | ELSE 271 | 272 | Y2K * IF A-P-DATE-OF-PAYMENT (WS-PAYMENT-SUB) > 273 | Y2K * A-M-DATE-OF-SERVICE (WS-MAINTENANCE-SUB) 274 | 275 | Y2K IF Y2K-DATE-2 > Y2K-DATE-3 276 | 277 | MOVE A-P-RECORD-TYPE TO H-RECORD-TYPE (I) 278 | MOVE WS-PAYMENT-ENTRY TO H-ENTRY (I) 279 | SUBTRACT 1 FROM WS-PAYMENT-ENTRY 280 | 281 | ELSE 282 | 283 | MOVE A-M-RECORD-TYPE TO H-RECORD-TYPE (I) 284 | MOVE WS-MAINTENANCE-ENTRY TO H-ENTRY (I) 285 | SUBTRACT 1 FROM WS-MAINTENANCE-ENTRY. 286 | 287 | 000-GET-DELIVERY-ENTRY. 288 | 289 | IF WS-DELIVERY-ENTRY = ZERO 290 | MOVE ZERO TO A-D-DATE-OF-DELIVERY (1) 291 | MOVE 1 TO WS-DELIVERY-SUB 292 | 293 | ELSE 294 | COMPUTE WS-DELIVERY-RECORD = 295 | (WS-DELIVERY-ENTRY - 1) / 20 296 | 297 | COMPUTE WS-DELIVERY-SUB = 298 | WS-DELIVERY-ENTRY - (WS-DELIVERY-RECORD * 20) 299 | 300 | IF WS-DELIVERY-RECORD NOT = A-D-RECORD-NUMBER 301 | 302 | MOVE WS-DELIVERY-RECORD TO A-D-RECORD-NUMBER 303 | 304 | EXEC CICS READ 305 | FILE ('ACCTFILE') 306 | INTO (ACCOUNT-DELIVERY-RECORD) 307 | RIDFLD (A-D-KEY) 308 | LENGTH (ACCTFILE-LENGTH) 309 | KEYLENGTH (ACCTFILE-KEYLENGTH) 310 | RESP (ACCTFILE-RESP) 311 | RESP2 (ACCTFILE-RESP2) 312 | END-EXEC 313 | 314 | IF ACCTFILE-RESP NOT = DFHRESP(NORMAL) 315 | MOVE ZERO TO A-D-DATE-OF-DELIVERY (1) 316 | MOVE 1 TO WS-DELIVERY-SUB 317 | MOVE ZERO TO WS-DELIVERY-ENTRY. 318 | 319 | 000-GET-PAYMENT-ENTRY. 320 | 321 | IF WS-PAYMENT-ENTRY = ZERO 322 | MOVE ZERO TO A-P-DATE-OF-PAYMENT (1) 323 | MOVE 1 TO WS-PAYMENT-SUB 324 | 325 | ELSE 326 | COMPUTE WS-PAYMENT-RECORD = 327 | (WS-PAYMENT-ENTRY - 1) / 20 328 | 329 | COMPUTE WS-PAYMENT-SUB = 330 | WS-PAYMENT-ENTRY - (WS-PAYMENT-RECORD * 20) 331 | 332 | IF WS-PAYMENT-RECORD NOT = A-P-RECORD-NUMBER 333 | 334 | MOVE WS-PAYMENT-RECORD TO A-P-RECORD-NUMBER 335 | 336 | EXEC CICS READ 337 | FILE ('ACCTFILE') 338 | INTO (ACCOUNT-PAYMENT-RECORD) 339 | RIDFLD (A-P-KEY) 340 | LENGTH (ACCTFILE-LENGTH) 341 | KEYLENGTH (ACCTFILE-KEYLENGTH) 342 | RESP (ACCTFILE-RESP) 343 | RESP2 (ACCTFILE-RESP2) 344 | END-EXEC 345 | 346 | IF ACCTFILE-RESP NOT = DFHRESP(NORMAL) 347 | MOVE ZERO TO A-P-DATE-OF-PAYMENT (1) 348 | MOVE 1 TO WS-PAYMENT-SUB 349 | MOVE ZERO TO WS-PAYMENT-ENTRY. 350 | 351 | 000-GET-MAINTENANCE-ENTRY. 352 | 353 | IF WS-MAINTENANCE-ENTRY = ZERO 354 | MOVE ZERO TO A-M-DATE-OF-SERVICE (1) 355 | MOVE 1 TO WS-MAINTENANCE-SUB 356 | 357 | ELSE 358 | COMPUTE WS-MAINTENANCE-RECORD = 359 | (WS-MAINTENANCE-ENTRY - 1) / 10 360 | 361 | COMPUTE WS-MAINTENANCE-SUB = 362 | WS-MAINTENANCE-ENTRY - (WS-MAINTENANCE-RECORD * 10) 363 | 364 | IF WS-MAINTENANCE-RECORD NOT = A-M-RECORD-NUMBER 365 | 366 | MOVE WS-MAINTENANCE-RECORD TO A-M-RECORD-NUMBER 367 | 368 | EXEC CICS READ 369 | FILE ('ACCTFILE') 370 | INTO (ACCOUNT-MAINTENANCE-RECORD) 371 | RIDFLD (A-M-KEY) 372 | LENGTH (ACCTFILE-LENGTH) 373 | KEYLENGTH (ACCTFILE-KEYLENGTH) 374 | RESP (ACCTFILE-RESP) 375 | RESP2 (ACCTFILE-RESP2) 376 | END-EXEC 377 | 378 | IF ACCTFILE-RESP NOT = DFHRESP(NORMAL) 379 | MOVE ZERO TO A-M-DATE-OF-SERVICE (1) 380 | MOVE 1 TO WS-MAINTENANCE-SUB 381 | MOVE ZERO TO WS-MAINTENANCE-ENTRY. 382 | 383 | 000-SEND-MAP. 384 | 385 | MOVE COMM-DISPLAY-DATE TO M4DATEO. 386 | MOVE COMM-MESSAGE TO M4MSGO. 387 | MOVE SPACE TO COMM-MESSAGE. 388 | 389 | ADD WS-FROM 7 GIVING WS-TO. 390 | 391 | IF WS-TO > WS-TABLE-ENTRIES 392 | MOVE WS-TABLE-ENTRIES TO WS-TO. 393 | 394 | MOVE WS-FROM TO WORK-NUM. 395 | MOVE WORK-NUM TO M4FROMO. 396 | MOVE WS-TO TO WORK-NUM. 397 | MOVE WORK-NUM TO M4TOO. 398 | MOVE WS-TABLE-ENTRIES TO WORK-NUM 399 | MOVE WORK-NUM TO M4OFO. 400 | 401 | MOVE COMM-ACCOUNT-ID TO A-D-ACCOUNT-ID. 402 | MOVE COMM-ACCOUNT-ID TO A-P-ACCOUNT-ID. 403 | MOVE COMM-ACCOUNT-ID TO A-M-ACCOUNT-ID. 404 | MOVE COMM-ACCOUNT-ID TO M4IDO. 405 | 406 | MOVE 9999 TO A-D-RECORD-NUMBER. 407 | MOVE 9999 TO A-P-RECORD-NUMBER. 408 | MOVE 9999 TO A-M-RECORD-NUMBER. 409 | 410 | MOVE 1 TO I. 411 | 412 | PERFORM 000-FILL-SCREEN 413 | VARYING WS-INDEX FROM WS-FROM BY 1 414 | UNTIL WS-INDEX > WS-TO. 415 | 416 | EXEC CICS SEND 417 | MAP ('SLICKM4') 418 | CURSOR 419 | ERASE 420 | END-EXEC. 421 | 422 | 000-FILL-SCREEN. 423 | 424 | IF H-RECORD-TYPE (WS-INDEX) = A-D-RECORD-TYPE 425 | PERFORM 000-FORMAT-DELIVERY 426 | 427 | ELSE 428 | IF H-RECORD-TYPE (WS-INDEX) = A-P-RECORD-TYPE 429 | PERFORM 000-FORMAT-PAYMENT 430 | 431 | ELSE 432 | IF H-RECORD-TYPE (WS-INDEX) = A-M-RECORD-TYPE 433 | PERFORM 000-FORMAT-MAINTENANCE. 434 | 435 | IF I = 1 436 | MOVE SCREEN-BUFFER TO M4L1O 437 | ELSE 438 | IF I = 2 439 | MOVE SCREEN-BUFFER TO M4L2O 440 | ELSE 441 | IF I = 3 442 | MOVE SCREEN-BUFFER TO M4L3O 443 | ELSE 444 | IF I = 4 445 | MOVE SCREEN-BUFFER TO M4L4O 446 | ELSE 447 | IF I = 5 448 | MOVE SCREEN-BUFFER TO M4L5O 449 | ELSE 450 | IF I = 6 451 | MOVE SCREEN-BUFFER TO M4L6O 452 | ELSE 453 | IF I = 7 454 | MOVE SCREEN-BUFFER TO M4L7O. 455 | 456 | ADD 1 TO I. 457 | 458 | 000-FORMAT-DELIVERY. 459 | MOVE H-ENTRY (WS-INDEX) TO WS-DELIVERY-ENTRY. 460 | PERFORM 000-GET-DELIVERY-ENTRY. 461 | MOVE A-D-DATE-OF-DELIVERY (WS-DELIVERY-SUB) 462 | TO TEMP-DATE. 463 | MOVE TEMP-YY TO D-M-YY. 464 | MOVE TEMP-MM TO D-M-MM. 465 | MOVE TEMP-DD TO D-M-DD. 466 | MOVE A-D-TECHNICIAN (WS-DELIVERY-SUB) TO D-M-EMPL. 467 | MOVE A-D-GALLONS (WS-DELIVERY-SUB) TO D-M-GALLONS. 468 | MOVE A-D-UNIT-PRICE (WS-DELIVERY-SUB) TO NUM-5. 469 | MOVE DOLLARS-5 TO D-5. 470 | MOVE CENTS-5 TO C-5. 471 | MOVE DC-5 TO D-M-UNIT-PRICE. 472 | MOVE DELIVERY-MESSAGE TO SCREEN-BUFFER. 473 | 474 | 000-FORMAT-PAYMENT. 475 | MOVE H-ENTRY (WS-INDEX) TO WS-PAYMENT-ENTRY 476 | PERFORM 000-GET-PAYMENT-ENTRY. 477 | MOVE A-P-DATE-OF-PAYMENT (WS-PAYMENT-SUB) 478 | TO TEMP-DATE. 479 | MOVE TEMP-YY TO P-M-YY. 480 | MOVE TEMP-MM TO P-M-MM. 481 | MOVE TEMP-DD TO P-M-DD. 482 | MOVE A-P-AMOUNT (WS-PAYMENT-SUB) TO NUM-8. 483 | MOVE DOLLARS-8 TO D-8. 484 | MOVE CENTS-8 TO C-8. 485 | MOVE DC-8 TO P-M-AMOUNT. 486 | MOVE PAYMENT-MESSAGE TO SCREEN-BUFFER. 487 | 488 | 000-FORMAT-MAINTENANCE. 489 | MOVE H-ENTRY (WS-INDEX) TO WS-MAINTENANCE-ENTRY 490 | PERFORM 000-GET-MAINTENANCE-ENTRY. 491 | MOVE A-M-DATE-OF-SERVICE (WS-MAINTENANCE-SUB) 492 | TO TEMP-DATE. 493 | MOVE TEMP-YY TO M-M-YY. 494 | MOVE TEMP-MM TO M-M-MM. 495 | MOVE TEMP-DD TO M-M-DD. 496 | 497 | MOVE A-M-TECHNICIAN (WS-MAINTENANCE-SUB) 498 | TO M-M-EMPL. 499 | 500 | IF A-M-SERVICE-CHARGE (WS-MAINTENANCE-SUB) = ZERO 501 | MOVE NO-CHARGE-MESSAGE TO M-M-SERVICE-CHARGE 502 | 503 | ELSE 504 | MOVE A-M-SERVICE-CHARGE (WS-MAINTENANCE-SUB) 505 | TO NUM-8 506 | MOVE DOLLARS-8 TO D-8 507 | MOVE CENTS-8 TO C-8 508 | MOVE DC-8 TO M-M-AMOUNT 509 | MOVE SERVICE-CHARGE-MESSAGE TO M-M-SERVICE-CHARGE. 510 | 511 | MOVE MAINTENANCE-MESSAGE TO SCREEN-BUFFER. 512 | 513 | 000-RECEIVE-MAP. 514 | 515 | IF EIBAID = DFHPF11 516 | SET COMM-MENU TO TRUE 517 | ELSE 518 | IF EIBAID = DFHPF12 519 | OR EIBAID = DFHPF24 520 | SET COMM-QUIT TO TRUE 521 | ELSE 522 | PERFORM 000-SCROLL. 523 | 524 | 000-SCROLL. 525 | 526 | IF EIBAID = DFHENTER 527 | NEXT SENTENCE 528 | ELSE 529 | IF EIBAID = DFHPF1 530 | MOVE 1 TO WS-FROM 531 | ELSE 532 | IF EIBAID = DFHPF2 533 | SUBTRACT 6 FROM WS-TABLE-ENTRIES 534 | GIVING WS-FROM 535 | ELSE 536 | IF EIBAID = DFHPF7 537 | SUBTRACT 7 FROM WS-FROM 538 | ELSE 539 | IF EIBAID = DFHPF8 540 | ADD 7 TO WS-FROM 541 | ELSE 542 | PERFORM 000-ALARM. 543 | 544 | IF WS-FROM > WS-TABLE-ENTRIES 545 | MOVE WS-TABLE-ENTRIES TO WS-FROM 546 | ELSE 547 | IF WS-FROM < 1 548 | MOVE 1 TO WS-FROM. 549 | 550 | 000-ALARM. 551 | 552 | EXEC CICS SEND CONTROL 553 | FREEKB 554 | ALARM 555 | END-EXEC. 556 | 557 | COPY SLICKNUM. 558 | -------------------------------------------------------------------------------- /sample/SLICKP5.cbl: -------------------------------------------------------------------------------- 1 | CBL XOPTS(COBOL2) 2 | IDENTIFICATION DIVISION. 3 | PROGRAM-ID. SLICKP5. 4 | AUTHOR. Ira M. Slick. 5 | ****************************************************************** 6 | *DESCRIPTION: Account Status * 7 | ****************************************************************** 8 | ENVIRONMENT DIVISION. 9 | CONFIGURATION SECTION. 10 | SOURCE-COMPUTER. IBM-PC. 11 | OBJECT-COMPUTER. IBM-PC. 12 | DATA DIVISION. 13 | WORKING-STORAGE SECTION. 14 | 15 | COPY SLICKCOM. 16 | 17 | COPY SLICKM5. 18 | 19 | COPY DFHAID. 20 | 21 | COPY ACCTFILE. 22 | 23 | 01 WS-MAP-FIELDS. 24 | 03 WS-NAME-LAST PIC X(16) VALUE SPACE. 25 | 03 WS-NAME-FIRST PIC X(16) VALUE SPACE. 26 | 03 WS-NAME-INITIAL PIC X(01) VALUE SPACE. 27 | 03 WS-ADDRESS PIC X(64) VALUE SPACE. 28 | 03 WS-CITY PIC X(24) VALUE SPACE. 29 | 03 WS-STATE PIC X(02) VALUE SPACE. 30 | 03 WS-ZIP PIC 9(05) VALUE ZERO. 31 | 03 WS-ZIP-EX PIC 9(04) VALUE ZERO. 32 | 03 WS-TEL-1A PIC 9(03) VALUE ZERO. 33 | 03 WS-TEL-1B PIC 9(03) VALUE ZERO. 34 | 03 WS-TEL-1C PIC 9(04) VALUE ZERO. 35 | 03 WS-TEL-2A PIC 9(03) VALUE ZERO. 36 | 03 WS-TEL-2B PIC 9(03) VALUE ZERO. 37 | 03 WS-TEL-2C PIC 9(04) VALUE ZERO. 38 | 03 WS-LAST-PAYMENT-DATE. 39 | 05 WS-L-P-YY PIC 9(02) VALUE ZERO. 40 | 88 NO-PAYMENTS VALUE ZERO. 41 | 05 WS-L-P-MM PIC 9(02) VALUE ZERO. 42 | 05 WS-L-P-DD PIC 9(02) VALUE ZERO. 43 | 03 WS-LAST-PAYMENT-AMOUNT PIC 9(08) VALUE ZERO. 44 | 03 WS-LAST-DELIVERY-DATE. 45 | 05 WS-L-D-YY PIC 9(02) VALUE ZERO. 46 | 88 NO-DELIVERIES VALUE ZERO. 47 | 05 WS-L-D-MM PIC 9(02) VALUE ZERO. 48 | 05 WS-L-D-DD PIC 9(02) VALUE ZERO. 49 | 03 WS-LAST-DELIVERY-AMOUNT PIC ZZZ9 VALUE ZERO. 50 | 03 WS-LAST-DELIVERY-PRICE PIC 9(05) VALUE ZERO. 51 | 03 WS-LAST-SERVICE-DATE. 52 | 05 WS-L-S-YY PIC 9(02) VALUE ZERO. 53 | 88 NO-SERVICE VALUE ZERO. 54 | 05 WS-L-S-MM PIC 9(02) VALUE ZERO. 55 | 05 WS-L-S-DD PIC 9(02) VALUE ZERO. 56 | 03 WS-LAST-SERVICE-CHARGE PIC 9(08) VALUE ZERO. 57 | 03 WS-NEXT-PAYMENT-DATE. 58 | 05 WS-N-P-YY PIC 9(02) VALUE ZERO. 59 | 05 WS-N-P-MM PIC 9(02) VALUE ZERO. 60 | 05 WS-N-P-DD PIC 9(02) VALUE ZERO. 61 | 03 WS-NEXT-PAYMENT-AMOUNT PIC 9(08) VALUE ZERO. 62 | 03 WS-BALANCE PIC 9(08) VALUE ZERO. 63 | 03 WS-CR PIC X(02) VALUE SPACE. 64 | 03 WS-LAST-AID PIC X(01) VALUE SPACE. 65 | 66 | 01 WS-FORMAT-TEL. 67 | 03 FILLER PIC X(01) VALUE '('. 68 | 03 WS-TEL-A PIC 9(03) VALUE ZERO. 69 | 03 FILLER PIC X(02) VALUE ') '. 70 | 03 WS-TEL-B PIC 9(03) VALUE ZERO. 71 | 03 FILLER PIC X(01) VALUE '-'. 72 | 03 WS-TEL-C PIC 9(04) VALUE ZERO. 73 | 74 | 01 WS-SUB PIC 9(02) VALUE ZERO. 75 | 76 | 01 WS-EXIT PIC X(11) VALUE 77 | 'Slick ended'. 78 | 79 | LINKAGE SECTION. 80 | 81 | 01 DFHCOMMAREA. 82 | 03 FILLER PIC X(01) 83 | OCCURS 1 TO 4096 TIMES 84 | DEPENDING ON EIBCALEN. 85 | 86 | PROCEDURE DIVISION. 87 | 88 | 000-START-PROCESSING. 89 | 90 | MOVE DFHCOMMAREA TO SLICK-COMM. 91 | MOVE LOW-VALUES TO SLICKM5I. 92 | 93 | IF COMM-INIT 94 | PERFORM 000-INITIALIZATION 95 | 96 | ELSE 97 | MOVE COMM-SAVE TO WS-MAP-FIELDS 98 | PERFORM 000-RECEIVE-MAP. 99 | 100 | IF COMM-NEXT-TRAN = EIBTRNID 101 | MOVE WS-MAP-FIELDS TO COMM-SAVE 102 | PERFORM 000-INITIALIZE-FIELDS 103 | PERFORM 000-SEND-MAP 104 | 105 | EXEC CICS RETURN 106 | TRANSID (COMM-NEXT-TRAN) 107 | COMMAREA (SLICK-COMM) 108 | END-EXEC 109 | 110 | ELSE 111 | SET COMM-INIT TO TRUE 112 | 113 | IF COMM-QUIT 114 | EXEC CICS SEND TEXT 115 | FROM (WS-EXIT) 116 | LENGTH (11) 117 | FREEKB 118 | ERASE 119 | END-EXEC 120 | 121 | EXEC CICS RETURN 122 | END-EXEC 123 | 124 | ELSE 125 | EXEC CICS RETURN 126 | TRANSID (COMM-NEXT-TRAN) 127 | COMMAREA (SLICK-COMM) 128 | IMMEDIATE 129 | END-EXEC. 130 | 131 | 000-INITIALIZATION. 132 | 133 | MOVE EIBTRNID TO COMM-NEXT-TRAN. 134 | MOVE SPACE TO COMM-INIT-FLAG. 135 | PERFORM 000-READ-STATISTICS. 136 | 137 | 000-READ-STATISTICS. 138 | 139 | MOVE COMM-ACCOUNT-ID TO A-S-ACCOUNT-ID. 140 | 141 | EXEC CICS READ 142 | FILE ('ACCTFILE') 143 | INTO (ACCOUNT-STATISTICS-RECORD) 144 | RIDFLD (A-S-KEY) 145 | LENGTH (ACCTFILE-LENGTH) 146 | KEYLENGTH (ACCTFILE-KEYLENGTH) 147 | RESP (ACCTFILE-RESP) 148 | RESP2 (ACCTFILE-RESP2) 149 | END-EXEC. 150 | 151 | IF ACCTFILE-RESP NOT = DFHRESP(NORMAL) 152 | MOVE ACCTFILE-RESP TO ERROR-RESP 153 | MOVE ACCTFILE-RESP2 TO ERROR-RESP2 154 | MOVE A-S-KEY TO ERROR-KEY 155 | MOVE 'READ' TO ERROR-TYPE 156 | MOVE ERROR-MESSAGE TO COMM-MESSAGE 157 | ELSE 158 | MOVE A-S-NAME-LAST TO WS-NAME-LAST 159 | MOVE A-S-NAME-FIRST TO WS-NAME-FIRST 160 | MOVE A-S-NAME-INITIAL TO WS-NAME-INITIAL 161 | MOVE A-S-ADDRESS TO WS-ADDRESS 162 | MOVE A-S-CITY TO WS-CITY 163 | MOVE A-S-STATE TO WS-STATE 164 | MOVE A-S-ZIP TO WS-ZIP 165 | MOVE A-S-ZIP-EX TO WS-ZIP-EX 166 | MOVE A-S-TEL-1A TO WS-TEL-1A 167 | MOVE A-S-TEL-1B TO WS-TEL-1B 168 | MOVE A-S-TEL-1C TO WS-TEL-1C 169 | MOVE A-S-TEL-2A TO WS-TEL-2A 170 | MOVE A-S-TEL-2B TO WS-TEL-2B 171 | MOVE A-S-TEL-2C TO WS-TEL-2C 172 | MOVE A-S-LAST-PAYMENT TO WS-LAST-PAYMENT-DATE 173 | MOVE A-S-LAST-DELIVERY TO WS-LAST-DELIVERY-DATE 174 | MOVE A-S-LAST-MAINTENANCE TO WS-LAST-SERVICE-DATE 175 | MOVE A-S-PAYMENT-DUE TO WS-NEXT-PAYMENT-DATE 176 | MOVE A-S-BUDGET-AMOUNT TO WS-NEXT-PAYMENT-AMOUNT 177 | MOVE A-S-BALANCE TO WS-BALANCE 178 | 179 | IF NOT NO-PAYMENTS 180 | PERFORM 000-READ-PAYMENT. 181 | 182 | IF NOT NO-DELIVERIES 183 | PERFORM 000-READ-DELIVERY. 184 | 185 | IF NOT NO-SERVICE 186 | PERFORM 000-READ-MAINTENANCE. 187 | 188 | IF A-S-BALANCE < ZERO 189 | MOVE 'CR' TO WS-CR. 190 | 191 | 000-READ-PAYMENT. 192 | 193 | MOVE COMM-ACCOUNT-ID TO A-P-ACCOUNT-ID. 194 | 195 | DIVIDE A-S-PAYMENT-ENTRIES BY 20 196 | GIVING A-P-RECORD-NUMBER 197 | REMAINDER WS-SUB. 198 | 199 | EXEC CICS READ 200 | FILE ('ACCTFILE') 201 | INTO (ACCOUNT-PAYMENT-RECORD) 202 | RIDFLD (A-P-KEY) 203 | LENGTH (ACCTFILE-LENGTH) 204 | KEYLENGTH (ACCTFILE-KEYLENGTH) 205 | RESP (ACCTFILE-RESP) 206 | RESP2 (ACCTFILE-RESP2) 207 | END-EXEC. 208 | 209 | IF ACCTFILE-RESP NOT = DFHRESP(NORMAL) 210 | MOVE ACCTFILE-RESP TO ERROR-RESP 211 | MOVE ACCTFILE-RESP2 TO ERROR-RESP2 212 | MOVE A-P-KEY TO ERROR-KEY 213 | MOVE 'READ' TO ERROR-TYPE 214 | MOVE ERROR-MESSAGE TO COMM-MESSAGE 215 | ELSE 216 | MOVE A-P-AMOUNT (WS-SUB) TO WS-LAST-PAYMENT-AMOUNT. 217 | 218 | 000-READ-DELIVERY. 219 | 220 | MOVE COMM-ACCOUNT-ID TO A-D-ACCOUNT-ID. 221 | 222 | DIVIDE A-S-DELIVERY-ENTRIES BY 20 223 | GIVING A-D-RECORD-NUMBER 224 | REMAINDER WS-SUB. 225 | 226 | EXEC CICS READ 227 | FILE ('ACCTFILE') 228 | INTO (ACCOUNT-DELIVERY-RECORD) 229 | RIDFLD (A-D-KEY) 230 | LENGTH (ACCTFILE-LENGTH) 231 | KEYLENGTH (ACCTFILE-KEYLENGTH) 232 | RESP (ACCTFILE-RESP) 233 | RESP2 (ACCTFILE-RESP2) 234 | END-EXEC. 235 | 236 | IF ACCTFILE-RESP NOT = DFHRESP(NORMAL) 237 | MOVE ACCTFILE-RESP TO ERROR-RESP 238 | MOVE ACCTFILE-RESP2 TO ERROR-RESP2 239 | MOVE A-D-KEY TO ERROR-KEY 240 | MOVE 'READ' TO ERROR-TYPE 241 | MOVE ERROR-MESSAGE TO COMM-MESSAGE 242 | ELSE 243 | MOVE A-D-GALLONS (WS-SUB) TO WS-LAST-DELIVERY-AMOUNT 244 | MOVE A-D-UNIT-PRICE (WS-SUB) TO WS-LAST-DELIVERY-PRICE. 245 | 246 | 000-READ-MAINTENANCE. 247 | 248 | MOVE COMM-ACCOUNT-ID TO A-M-ACCOUNT-ID. 249 | 250 | DIVIDE A-S-MAINTENANCE-ENTRIES BY 10 251 | GIVING A-M-RECORD-NUMBER 252 | REMAINDER WS-SUB. 253 | 254 | EXEC CICS READ 255 | FILE ('ACCTFILE') 256 | INTO (ACCOUNT-MAINTENANCE-RECORD) 257 | RIDFLD (A-M-KEY) 258 | LENGTH (ACCTFILE-LENGTH) 259 | KEYLENGTH (ACCTFILE-KEYLENGTH) 260 | RESP (ACCTFILE-RESP) 261 | RESP2 (ACCTFILE-RESP2) 262 | END-EXEC. 263 | 264 | IF ACCTFILE-RESP NOT = DFHRESP(NORMAL) 265 | MOVE ACCTFILE-RESP TO ERROR-RESP 266 | MOVE ACCTFILE-RESP2 TO ERROR-RESP2 267 | MOVE A-M-KEY TO ERROR-KEY 268 | MOVE 'READ' TO ERROR-TYPE 269 | MOVE ERROR-MESSAGE TO COMM-MESSAGE 270 | ELSE 271 | MOVE A-M-SERVICE-CHARGE (WS-SUB) 272 | TO WS-LAST-SERVICE-CHARGE. 273 | 274 | 000-INITIALIZE-FIELDS. 275 | 276 | MOVE COMM-ACCOUNT-ID TO M5IDO. 277 | MOVE WS-NAME-LAST TO M5LASTO. 278 | MOVE WS-NAME-FIRST TO M5FIRSTO. 279 | MOVE WS-NAME-INITIAL TO M5INITO. 280 | MOVE WS-ADDRESS TO M5ADDRO. 281 | MOVE WS-CITY TO M5CITYO. 282 | MOVE WS-STATE TO M5STATEO. 283 | MOVE WS-ZIP TO M5ZIPO. 284 | MOVE WS-ZIP-EX TO M5ZIPXO. 285 | MOVE WS-TEL-1A TO WS-TEL-A. 286 | MOVE WS-TEL-1B TO WS-TEL-B. 287 | MOVE WS-TEL-1C TO WS-TEL-C. 288 | MOVE WS-FORMAT-TEL TO M5TEL1O. 289 | MOVE WS-TEL-2A TO WS-TEL-A. 290 | MOVE WS-TEL-2B TO WS-TEL-B. 291 | MOVE WS-TEL-2C TO WS-TEL-C. 292 | MOVE WS-FORMAT-TEL TO M5TEL2O. 293 | MOVE WS-L-P-YY TO WORK-YY. 294 | MOVE WS-L-P-MM TO WORK-MM. 295 | MOVE WS-L-P-DD TO WORK-DD. 296 | MOVE WORK-DATE TO M5DPAYO. 297 | MOVE WS-LAST-PAYMENT-AMOUNT TO NUM-8. 298 | MOVE DOLLARS-8 TO D-8. 299 | MOVE CENTS-8 TO C-8. 300 | MOVE DC-8 TO M5APAYO. 301 | MOVE WS-L-D-YY TO WORK-YY. 302 | MOVE WS-L-D-MM TO WORK-MM. 303 | MOVE WS-L-D-DD TO WORK-DD. 304 | MOVE WORK-DATE TO M5DDELO. 305 | MOVE WS-LAST-DELIVERY-AMOUNT TO M5ADELO. 306 | MOVE WS-LAST-DELIVERY-PRICE TO NUM-5. 307 | MOVE DOLLARS-5 TO D-5. 308 | MOVE CENTS-5 TO C-5. 309 | MOVE DC-5 TO M5PDELO. 310 | MOVE WS-L-S-YY TO WORK-YY. 311 | MOVE WS-L-S-MM TO WORK-MM. 312 | MOVE WS-L-S-DD TO WORK-DD. 313 | MOVE WORK-DATE TO M5DSVCO. 314 | MOVE WS-LAST-SERVICE-CHARGE TO NUM-8. 315 | MOVE DOLLARS-8 TO D-8. 316 | MOVE CENTS-8 TO C-8. 317 | MOVE DC-8 TO M5ASVCO. 318 | MOVE WS-N-P-YY TO WORK-YY. 319 | MOVE WS-N-P-MM TO WORK-MM. 320 | MOVE WS-N-P-DD TO WORK-DD. 321 | MOVE WORK-DATE TO M5DNEXTO. 322 | MOVE WS-NEXT-PAYMENT-AMOUNT TO NUM-8. 323 | MOVE DOLLARS-8 TO D-8. 324 | MOVE CENTS-8 TO C-8. 325 | MOVE DC-8 TO M5ANEXTO. 326 | MOVE WS-BALANCE TO NUM-8. 327 | MOVE DOLLARS-8 TO D-8. 328 | MOVE CENTS-8 TO C-8. 329 | MOVE DC-8 TO M5BALO. 330 | MOVE WS-CR TO M5CRO. 331 | 332 | 000-SEND-MAP. 333 | 334 | MOVE COMM-DISPLAY-DATE TO M5DATEO. 335 | MOVE COMM-MESSAGE TO M5MSGO. 336 | MOVE SPACE TO COMM-MESSAGE. 337 | 338 | IF NOT BAD-DATA 339 | MOVE -1 TO M5MSGL. 340 | 341 | EXEC CICS SEND 342 | MAP ('SLICKM5') 343 | CURSOR 344 | ERASE 345 | END-EXEC. 346 | 347 | IF M5MSGO NOT = SPACE 348 | PERFORM 000-ALARM. 349 | 350 | 000-RECEIVE-MAP. 351 | 352 | IF EIBAID = DFHPF11 353 | SET COMM-MENU TO TRUE 354 | ELSE 355 | IF EIBAID = DFHPF12 356 | OR EIBAID = DFHPF24 357 | SET COMM-QUIT TO TRUE 358 | ELSE 359 | IF EIBAID NOT = DFHENTER 360 | MOVE 'Invalid Key' TO COMM-MESSAGE. 361 | 362 | 000-ALARM. 363 | 364 | EXEC CICS SEND CONTROL 365 | FREEKB 366 | ALARM 367 | END-EXEC. 368 | 369 | COPY SLICKNUM. 370 | -------------------------------------------------------------------------------- /tooltip.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/BroadcomMFD/cobol-control-flow/9dd5b6f03b60ae2806143afe577a4810a54e930a/tooltip.gif --------------------------------------------------------------------------------