A journey into the past: Programming with GNU COBOL

Latest version of this document | Read more articles

Back in early autumn 2015 my interest was sparked by a post on Slashdot that linked to an article on opensource.com. It discussed three Open Source projects relating to COBOL; a compile in GnuCOBOL, a COBOL IDE in OpenCOBOL IDE, and a Node.js to COBOL bridge.

Having been programming since the early eighties (BASIC on the Sinclair ZX-81 and ZX-Spectrum, Tandy TRS-80, Amstrad PCW, IBM PC and Atari ST) and then gone on to learn programming at University (Pascal, C, Ada, OCCAM), I was intrigued to find out that people were still writing COBOL and still actively developing tools for the language; after all as far as I knew the language was already considered a relic the Eighties. Most surprising was to find out that the latest official specification for the ISO standard of COBOL was COBOL 2014!

Having been doing it since the late 90s, I'd become a little bored with web development (or rather writing applications for the web) for some time. 20s years of doing it has lead to me being really not that excited by the latest you just struggle for ages with npm to get this amazing JavaScript framework installed and then look it's easy and amazing and also a little jaded at whether Python, or Ruby, or PHP, or Perl, or Drupal, or WordPress, or Node, or React.js, or Angular, or whatever, really is what I should be using to deliver yet another website for yet another person or company with year another great idea. I think you get the point.

So the idea of going back in time and back to basics and learning a programming language that had quite a different beginning and different paradigm to others I've used and one that I'd never looked at before really appealed to me. In addition, one that I could write straight-forward programs that had no layered APIs and frameworks and allowed me to interact directly with the screen, keyboard, and other input-output devices also appealed. So I thought to myself, 'why not learn COBOL?'; and that's just what I did!

A brief history COBOL

Briefly, because you can read about this on Wikipedia, COBOL was devised by CODASYL way back in 1958 and the first specification released in 1960. Grace Hopper (who is also purportedly the first person to debug a computer (there was literally a moth stuck in a relay of a Harvard Mark II computer)) is accredited as being the main influence behind COBOL through her previous work with FLOW-MATIC. Anyway, the long and the short of it was that it was a comittee formed of members from US government and industry that undertook the development of an open specification for a programming language that would be cross-platform.

By around 1974 COBOL was the most widely used programming language in the World and had become an ANSI standard (in fact was on it's third incarnation, COBOL-74). Since then there have been three subsequent major versions, ANSI-85, ISO-2002 and ISO-2014.

Anyway, as I said there's plenty of information on-line about that, so I won't go on.

COBOL basics

One of the key oddities of COBOL for programmers of other computer languages, and the computer science community in general, is that it's design principals, which included making the code human-readable, means that it does things in quite a different way to most languages, and therefore stands alone.

Hello World

Here's a version of the Hello World program written using OpenCOBOL IDE for COBOL 85. Note I used lower case syntax for keywords rather than the older use of UPPER CASE; either is acceptable in COBOL. The line numbers are there for reference and aren't part of the program.

program-id. HelloWorld.
procedure division.
display "Hello World!".

Let's look at the same program using classic COBOL with upper case and line numbering:

00001 ******************************************************************
00002 * Author: Mike Harris
00003 * Date: 27th April 2016
00004 * Purpose: To demonstrate the Hello World program in COBOL
00005 * Compiler: cobc
00006 ******************************************************************
00010  IDENTIFICATION DIVISION.
00011  PROGRAM-ID. HELLO-WORLD.
00100  ENVIRONMENT DIVISION.
00110  PROCEDURE DIVISION.
00120  MAIN-PROCEDURE.
00130       DISPLAY "Hello world"
00140       STOP RUN.
00150  END PROGRAM HELLO-WORLD.
 

This format is called fixed format and was suitable for punch cards; other programming languages, such as FORTRAN, also originally used this style of format.

I prefer the more modern approach, called free format, and also prefer including some of the keywords that, although aren't required, do I think make the program more readable. For example:

identification division.
program-id. HelloWorld.
procedure division.
    display "Hello World!"
    stop run
    .
end program HelloWorld.

Monty Hall

Okay, let's now look at something bigger. The following is a possible solution to the Monty Hall problem. The listing is first and then I'll explain it to you:

identification division.
program-id. MontyHall.
 
data division.
working-storage section.
 
    01 CurrentTime.
        02 filler   pic 9(4).
        02 Seed     pic 9(4).
 
    01 DoorThatHasCar pic 9.
    01 DoorPlayerChooses pic 9.
 
    01 Round pic 9(4).
    01 NumberOfRoundsToPlay constant 1000.
    01 WinsWhenNotSwapping pic 9(3) value zero.
    01 WinsWhenSwapping pic 9(3) value zero.
 
procedure division.
 
    accept CurrentTime from time
    compute DoorThatHasCar = function random(Seed)
 
    perform with test after varying Round from 1 by 1
        until Round equal to NumberOfRoundsToPlay
        compute DoorThatHasCar = (function random * 3) + 1
        compute DoorPlayerChooses = (function random * 3) + 1
        if DoorThatHasCar equal to DoorPlayerChooses then
            add 1 to WinsWhenNotSwapping
        else
            add 1 to WinsWhenSwapping
        end-if
    end-perform
 
    display "Results"
    display "-------"
    display "After playing " Round " rounds ..."
    display "Times correct door selected after swapping:   " WinsWhenSwapping
    display "Times correct door selected without swapping: " WinsWhenNotSwapping
    display spaces
 
    evaluate true
        when WinsWhenNotSwapping greater than WinsWhenSwapping
            display
                "Conclusion is that it's better not to swap."
                "  Which doesn't make much sense, but hey!"
            end-display
        when WinsWhenNotSwapping equal to WinsWhenSwapping
            display
                "There's no conclusion; they are equal outcomes."
                "  Which shouldn't really be the case."
            end-display
        when other
            display
                "Conclusion is that it's better to swap."
                "  This makes sense as the probability in the first round of getting"
                "  the correct door is 1/3; whereas in the second, it's 1/2."
            end-display
    end-evaluate
 
    stop run.
 
end program MontyHall.
 

Putting it all together

I've been involved in running an event called BarnCamp for some years now. We had a website, built in Ruby-on-Rails, that captures sign-ups and can export them in CSV format. We needed some way on site of tracking who had arrived on what day, whether they'd paid and how much on site. In the past we'd used a spreadsheet for this, but in 2017 I decided to try an application dedicated to the task.

This application needed to solve the following needs:

• We know who's on-site and who's to arrive
• We have a total of money paid to us
• We have a total of money to come in
• We know at any time how many people are on site for the purposes of knowing how many to cook for and in case of an emergency
• We know how many nights people camped for and can pay the farm the appropriate amount of money
• We have a list of people's emails and numbers so that we can get in touch with them, on or off site
• We know how many kids are on site

I implemented the BarnCamp Attendees Management System (BAMS) in GNU COBOL to provide a solution for the event. This application used lots of COBOL features, including:

• Copybooks
• SCREEN section
• Direct Access Files
• Use of SEARCH, UNSTRING and STRING

Main code for BAMS

identification division.
program-id. BAMS.
 
environment division.
configuration section.
    special-names.
        crt status is CommandKeys.
        alphabet mixed is " ZzYyXxWwVvUuTtSsRrQqPpOoNnMmLlKkJjIiHhGgFfEeDdCcBbAa".
        class HexNumber is "0" thru "9", "A" thru "F", "a" thru "f".
    repository.
        function all intrinsic.
 
input-output section.
    file-control.
        select optional AttendeesFile assign to AttendeesFileName
            organization is indexed
            access mode is dynamic
            record key is AuthCode of AttendeeRecord
            file status is DataFileStatus.
 
        select optional BackupFile assign to BackupFileName
            organization is line sequential.
 
data division.
file section.
fd AttendeesFile.
copy DD-Attendee replacing Attendee by
    ==AttendeeRecord.
    88 EndOfAttendeesFile value high-values==.
 
fd BackupFile.
copy DD-Attendee replacing Attendee by
    ==BackupRecord.
    88 EndOfBackupFile value high-values==.
 
working-storage section.
01 AddAttendeeFlag pic 9 value 0.
    88 AddAttendeeFlagOn value 1 when set to false is 0.
 
01 AttendeesFileName pic x(20).
01 BackupFileName pic x(20).
 
01 DataFileStatus   pic x(2).
    88 Successful   value "00".
    88 RecordExists value "22".
    88 NoSuchRecord value "23".
 
01 AttendeesTable.
copy DD-Attendee replacing 01 by 02 Attendee by
    ==Attendee occurs 1 to 200 times
            depending on NumberOfAttendees
            ascending key is Name
            ascending key is Email
            ascending key is AuthCode
            indexed by AttendeeIndex==.
 
01 AuthCodeToSearchFor pic x(6) value all "0".
 
01 BarnCampStats.
    02 PeopleOnSite pic 999 value zero.
    02 PeopleSignedUp pic 999 value zero.
    02 PeopleStayingTillMonday pic 999 value zero.
    02 PeopleToArrive pic 999 value zero.
    02 PeopleToArriveToday pic 999 value zero.
    02 PeopleToBeOnSiteToday pic 999 value zero.
    02 KidsOnSite pic 99 value zero.
    02 KidsToArrive pic 99 value zero.
    02 KidsToArriveToday pic 99 value zero.
    02 TotalEstimatedAttendees pic 999 value zero.
    02 TotalEstimatedKids pic 99 value zero.
 
01 EmailToSearchFor pic x(40) value spaces.
 
01 EventTable.
    02 EventFileName pic x(20) value "attendees.dat".
    02 EventName pic x(30) value "BarnCamp".
    02 EventNamePosition pic 99 value 8.
 
01 NameToSearchFor pic x(25).
01 NumberOfAttendees pic 999.
 
01 Command pic x.
copy DD-CommandKeys.
 
01 CommandLineArgumentCount pic 9 value zero.
 
copy DD-Attendee replacing Attendee by
        ==CurrentAttendee==.
 
01 CurrentAttendeeNumber pic 999 value zero.
01 CurrentRow pic 99 value zero.
 
01 CurrentDayOfWeek pic 9 value zero.
01 DaysOfTheWeek value "MonTueWedThuFriSatSun".
    02 DayOfTheWeek pic xxx occurs 7 times.
        88 ValidDayOfWeek values "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun".
 
01 DefaultAmountToPay constant as 50.
 
01 FirstRecordToShow pic 999 value 1.
 
01 ColourScheme.
    88 ColourSchemeIsMonochrome value 02.
    88 ColourSchemeIsColour value 17.
    02 BackgroundColour pic 9 value 0.
    02 ForegroundColour pic 9 value 2.
 
01 LastRecordToShow pic 999 value 20.
01 PageOffset pic 999 value 1.
01 RecordsPerPage constant as 20.
01 RecordSelected pic 999.
 
01 RecordStatus pic 9 value 0.
    88 RecordFound value 1 when set to false is 0.
 
copy DD-ScreenHeader.
 
screen section.
01 HomeScreen background-color BackgroundColour foreground-color ForegroundColour.
    03 blank screen.
    03 line 1 column 1 from ScreenHeader reverse-video.
    03 line 5 column EventNamePosition from EventName.
    03 line 7 column 34 value "Today is ".
    03 line 7 column plus 1 from DayOfTheWeek(CurrentDayOfWeek).
    03 line 10 column 5 value "Adults on site: ".
    03 pic zzz9 line 10 column plus 3 from PeopleOnSite.
    03 line 11 column 5 value "Adults to arrive: ".
    03 pic zzz9 line 11 column plus 1 from PeopleToArrive.
    03 line 12 column 5 value "                " underline.
    03 line 13 column 5 value "Total adults:    ".
    03 pic zzz9 line 13 column plus 2 from TotalEstimatedAttendees.
    03 line 16 column 5 value "To arrive today: ".
    03 pic zzz9 line 16 column plus 2 from PeopleToArriveToday.
    03 line 17 column 5 value "To be onsite today: ".
    03 pic zzz9 line 17 column minus 1 from PeopleToBeOnSiteToday.
    03 line 19 column 5 value "Staying till Mon: ".
    03 pic zzz9 line 19 column plus 1 from PeopleStayingTillMonday.
    03 line 10 column 50 value "Kids on-site: ".
    03 pic z9 line 10 column plus 5 from KidsOnSite.
    03 line 11 column 50 value "Kids to arrive: ".
    03 pic z9 line 11 column plus 3 from KidsToArrive.
    03 line 12 column 50 value "           " underline.
    03 line 13 column 50 value "Total kids:".
    03 pic z9 line 13 column plus 8 from TotalEstimatedKids.
    03 line 16 column 45 value "Kids to arrive today: ".
    03 pic z9 line 16 column plus 2 from KidsToArriveToday.
    03 line 24 column 1
        value "Commands: F2 List, F3 Add, F4 Edit, F9 Mono/Colour, F10 Exit                       " reverse-video.
    03 line 24 column 78 to Command.
 
01 EditScreen background-color BackgroundColour foreground-color ForegroundColour.
    03 blank screen.
    03 line 1 column 1 from ScreenHeader reverse-video.
    03 line 2 column 1 value "AuthCode:".
    03 line 2 column 15 from AuthCode of CurrentAttendee.
    03 line 2 column 76 value "#".
    03 line 2 column plus 1 from CurrentAttendeeNumber.
    03 line 4 column 1 value "Name:".
    03 line 4 column 15 using Name of CurrentAttendee required.
    03 line 6 column 1 value "Email:".
    03 line 6 column 15 using Email of CurrentAttendee.
    03 line 8 column 1 value "Telephone:".
    03 line 8 column 15 using Telephone of CurrentAttendee.
    03 line 10 column 1 value "Arrival day:".
    03 line 10 column 15 from ArrivalDay of CurrentAttendee.
    03 line 10 column plus 2 value "(Wed/Thu/Fri/Sat)".
    03 line 12 column 1 value "Status:".
    03 line 12 column 15 from AttendanceStatus of CurrentAttendee.
    03 line 12 column plus 2 value "(A = arrived, C = coming, X = cancelled)".
    03 line 14 column 1 value "Kids:".
    03 pic 9 line 14 column 15 using NumberOfKids of CurrentAttendee required.
    03 line 16 column 1 value "Pay amount:".
    03 pic 999 line 16 column 15 using AmountToPay of CurrentAttendee required full.
    03 line 18 column 1 value "Paid?:".
    03 line 18 column 15 from PaymentStatus of CurrentAttendee.
    03 line 20 column 1 value "Diet issues:".
    03 line 20 column 15 using Diet of CurrentAttendee.
    03 line 24 column 1 value "Commands: F1 Home; Toggle: F5 Arrival, F6 Status, F7 Paid; F8 Save            " reverse-video.
    03 line 24 column 78 to Command.
 
01 ListScreen background-color BackgroundColour foreground-color ForegroundColour.
    03 blank screen.
    03 line 1 column 1 from ScreenHeader reverse-video.
    03 line 2 column 1 value "Num" underline.
    03 line 2 column 6 value "Name" underline.
    03 line 2 column 31 value "Email" underline.
    03 line 2 column 71 value "AuthCode" underline.
    03 line 24 column 1 value "Commands: F1 Home, PgUp/PgDown to scroll, Enter number and press ENTER         " reverse-video.
 
01 SearchScreen background-color BackgroundColour foreground-color ForegroundColour.
    03 blank screen.
    03 line 1 column 1 from ScreenHeader reverse-video.
    03 line 2 column 1 value "Enter AuthCode, Name, or Email and search - F2 to list all attendees:".
    03 line 4 column 1 value "AuthCode: ".
    03 line 4 column plus 2 to AuthCodeToSearchFor.
    03 line 6 column 1 value "Name:     ".
    03 line 6 column plus 2 to NameToSearchFor.
    03 line 8 column 1 value "Email:    ".
    03 line 8 column plus 2 to EmailToSearchFor.
    03 line 24 column 1
        value "Commands: F1 Home, F2 List; Search: F5 AuthCode, F6 Name, F7 Email           " reverse-video.
 
01 ViewScreen background-color BackgroundColour foreground-color ForegroundColour.
    03 blank screen.
    03 line 1 column 1 from ScreenHeader reverse-video.
    03 line 2 column 1 value "AuthCode:".
    03 line 2 column 15 from AuthCode of CurrentAttendee.
    03 line 4 column 1 value "Name:".
    03 line 4 column 15 from Name of CurrentAttendee.
    03 line 6 column 1 value "Email:".
    03 line 6 column 15 from Email of CurrentAttendee.
    03 line 8 column 1 value "Telephone:".
    03 line 8 column 15 from Telephone of CurrentAttendee.
    03 line 10 column 1 value "Arrival day:".
    03 line 10 column 15 from ArrivalDay of CurrentAttendee.
    03 line 12 column 1 value "Status:".
    03 line 12 column 15 from AttendanceStatus of CurrentAttendee.
    03 line 14 column 1 value "Kids:".
    03 line 14 column 15 from NumberOfKids of CurrentAttendee.
    03 line 16 column 1 value "Pay amount:".
    03 pic 999 line 16 column 15 from AmountToPay of CurrentAttendee.
    03 line 18 column 1 value "Paid?:".
    03 line 18 column 15 from PaymentStatus of CurrentAttendee.
    03 line 20 column 1 value "Diet issues:".
    03 line 20 column 15 from Diet of CurrentAttendee.
    03 line 24 column 1
        value "Commands: F1 Home, F4 Edit                                                   " reverse-video.
    03 line 24 column 78 to Command.
 
procedure division.
 
Main section.
    perform EnableExtendedKeyInput
    perform LoadEventDetails
    perform SetupAttendeesDataFileName
    perform LoadDataFileIntoTable
    set ColourSchemeIsColour to true
 
    perform until CommandKeyIsF10
        perform DisplayHomeScreen
    end-perform
 
    stop run
.
 
EnableExtendedKeyInput section.
    set environment 'COB_SCREEN_EXCEPTIONS' to 'Y'
    set environment 'COB_SCREEN_ESC' to 'Y'
.
 
LoadEventDetails section.
    compute EventNamePosition = 40 - (length(trim(EventName)) / 2)
.
 
SetupAttendeesDataFileName section.
    accept CommandLineArgumentCount from argument-number
    if CommandLineArgumentCount equal to 1 then
        accept AttendeesFileName from argument-value
    else
        move EventFileName to AttendeesFileName
    end-if
.
 
LoadDataFileIntoTable section.
    move zeroes to AuthCode of AttendeeRecord
    start AttendeesFile key is greater than AuthCode of AttendeeRecord
    open input AttendeesFile
        read AttendeesFile next record
            at end set EndOfAttendeesFile to true
        end-read
        if not EndOfAttendeesFile then
            perform with test before varying NumberOfAttendees from 1 by 1 until EndOfAttendeesFile
                move AttendeeRecord to Attendee(NumberOfAttendees)
                read AttendeesFile next record
                    at end set EndOfAttendeesFile to true
                end-read
            end-perform
        end-if
    close AttendeesFile
 
    sort Attendee
        on descending key Name of Attendee
        collating sequence is mixed
.
 
DisplayHomeScreen section.
    perform SetupHomeScreenStats
    accept HomeScreen from crt end-accept
    evaluate true
        when CommandKeyIsF2
            perform ListAttendees
            perform EditAttendee
        when CommandKeyIsF3 perform AddAttendee
        when CommandKeyIsF4 perform SearchAttendees
        when CommandKeyIsF9
            if ColourSchemeIsMonochrome then
                set ColourSchemeIsColour to true
            else
                set ColourSchemeIsMonochrome to true
            end-if
    end-evaluate
.
 
SetupHomeScreenStats section.
    accept CurrentDayOfWeek from day-of-week
    initialize PeopleSignedUp, PeopleOnSite, PeopleToArrive, PeopleToArriveToday,
        KidsOnSite, KidsToArrive, KidsToArriveToday
    perform varying CurrentAttendeeNumber from 1 by 1
        until CurrentAttendeeNumber equal to NumberOfAttendees
            evaluate true
                when AttendeeArrived of Attendee(CurrentAttendeeNumber)
                    add 1 to PeopleOnSite
                    add NumberOfKids of Attendee(CurrentAttendeeNumber) to KidsOnSite
                    if CanStayTillMonday of Attendee(CurrentAttendeeNumber) then
                        add 1 to PeopleStayingTillMonday
                    end-if
                when AttendeeComing of Attendee(CurrentAttendeeNumber)
                    add 1 to PeopleToArrive
                    add NumberOfKids of Attendee(CurrentAttendeeNumber) to KidsToArrive
                    if ValidDayOfWeek(CurrentDayOfWeek) and
                        ArrivalDay of Attendee(CurrentAttendeeNumber) is greater than or equal to DayOfTheWeek(CurrentDayOfWeek) then
                        add 1 to PeopleToArriveToday
                        add NumberOfKids of Attendee(CurrentAttendeeNumber) to KidsToArriveToday
                    end-if
            end-evaluate
            add 1 to PeopleSignedUp
            add PeopleToArriveToday to PeopleOnSite giving PeopleToBeOnSiteToday
        end-perform
 
    add PeopleToArrive to PeopleOnSite giving TotalEstimatedAttendees
    add KidsToArrive to KidsOnSite giving TotalEstimatedKids
.
 
ListAttendees section.
    sort Attendee
        on descending key Name of Attendee
        collating sequence is mixed
 
    move zero to PageOffset
    perform until CommandKeyIsF1 or CommandKeyIsEnter
        display ListScreen
        add 1 to PageOffset giving FirstRecordToShow
        move 3 to CurrentRow
        add PageOffset to RecordsPerPage giving LastRecordToShow
        perform varying CurrentAttendeeNumber from FirstRecordToShow by 1
            until CurrentAttendeeNumber greater than LastRecordToShow or
                CurrentAttendeeNumber equal to NumberOfAttendees
            display CurrentAttendeeNumber
                at line CurrentRow
                background-color BackgroundColour
                foreground-color ForegroundColour
            end-display
            display Name of Attendee(CurrentAttendeeNumber)
                at line CurrentRow
                column 6
                background-color BackgroundColour
                foreground-color ForegroundColour
            end-display
            display Email of Attendee(CurrentAttendeeNumber)
                at line CurrentRow
                column 31
                background-color BackgroundColour
                foreground-color ForegroundColour
            end-display
            display AuthCode of Attendee(CurrentAttendeeNumber)
                at line CurrentRow
                column 71
                background-color BackgroundColour
                foreground-color ForegroundColour
            end-display
            display AttendanceStatus of Attendee(CurrentAttendeeNumber)
                at line CurrentRow
                column 80
                background-color BackgroundColour
                foreground-color ForegroundColour
            end-display
            add 1 to CurrentRow
        end-perform
        accept RecordSelected at line 24 column 78 foreground-color ForegroundColour
        evaluate true also true
            when CommandKeyIsPgDn also LastRecordToShow is less than NumberOfAttendees
                add RecordsPerPage to PageOffset
            when CommandKeyIsPgUp also PageOffset is greater than or equal to RecordsPerPage
                subtract RecordsPerPage from PageOffset
        end-evaluate
    end-perform
 
    if CommandKeyIsEnter
            and RecordSelected greater than zero
            and RecordSelected is less than or equal to NumberOfAttendees then
        move Attendee(RecordSelected) to CurrentAttendee
        move RecordSelected to CurrentAttendeeNumber
        set RecordFound to true
        set AddAttendeeFlagOn to false
    else
        set RecordFound to false
    end-if
.
 
EditAttendee section.
    if not RecordFound then
        exit section
    end-if
 
    perform until CommandKeyIsF1 or CommandKeyIsF8
        accept EditScreen from crt end-accept
        evaluate true
            when CommandKeyIsF8
                perform SaveAttendee
                perform ViewAttendee
            when CommandKeyIsF7
                evaluate true
                    when AttendeePaid of CurrentAttendee set AttendeeNotPaid of CurrentAttendee to true
                    when AttendeeNotPaid of CurrentAttendee set AttendeePaid of CurrentAttendee to true
                end-evaluate
            when CommandKeyIsF5
                evaluate true
                    when ArrivalDayIsWednesday of CurrentAttendee set ArrivalDayIsThursday of CurrentAttendee to true
                    when ArrivalDayIsThursday of CurrentAttendee set ArrivalDayIsFriday of CurrentAttendee to true
                    when ArrivalDayIsFriday of CurrentAttendee set ArrivalDayIsSaturday of CurrentAttendee to true
                    when ArrivalDayIsSaturday of CurrentAttendee set ArrivalDayIsWednesday of CurrentAttendee to true
                end-evaluate
            when CommandKeyIsF6
                evaluate true
                    when AttendeeComing of CurrentAttendee set AttendeeArrived of CurrentAttendee to true
                    when AttendeeArrived of CurrentAttendee set AttendeeCancelled of CurrentAttendee to true
                    when AttendeeCancelled of CurrentAttendee set AttendeeComing of CurrentAttendee to true
                end-evaluate
        end-evaluate
    end-perform
.
 
SaveAttendee section.
    perform CreateTimeStampedBackupFile
    open i-o AttendeesFile
    evaluate true
        when AddAttendeeFlagOn
            add 1 to CurrentAttendeeNumber
            set NumberOfAttendees to CurrentAttendeeNumber
            move CurrentAttendee to Attendee(CurrentAttendeeNumber)
            write AttendeeRecord from Attendee(CurrentAttendeeNumber)
        when not AddAttendeeFlagOn
            move CurrentAttendee to Attendee(CurrentAttendeeNumber)
            rewrite AttendeeRecord from Attendee(CurrentAttendeeNumber)
    end-evaluate
    close AttendeesFile
.
 
CreateTimeStampedBackupFile section.
    move concatenate(formatted-current-date("YYYYMMDDThhmmss"), ".bak") to BackupFileName
    open output BackupFile
    perform varying CurrentRow from 1 by 1
        until CurrentRow equal to NumberOfAttendees
        move Attendee(CurrentRow) to BackupRecord
        write BackupRecord
    end-perform
    close BackupFile
.
 
ViewAttendee section.
    perform until CommandKeyIsF1
        accept ViewScreen end-accept
        evaluate true
            when CommandKeyIsF4 perform EditAttendee
        end-evaluate
    end-perform
.
 
AddAttendee section.
    initialize CurrentAttendee
    call "createAuthCode" using by reference AuthCode of CurrentAttendee
    move DayOfTheWeek(CurrentDayOfWeek) to ArrivalDay of CurrentAttendee
    set AttendeeArrived of CurrentAttendee to true
    set AttendeeNotPaid of CurrentAttendee to true
    move DefaultAmountToPay to AmountToPay of CurrentAttendee
    set AddAttendeeFlagOn to true
    set RecordFound to true
    perform EditAttendee
.
 
SearchAttendees section.
    initialize CurrentAttendee
    set RecordFound to false
    perform until CommandKeyIsF1 or CommandKeyIsF2 or CommandKeyIsF5
        or CommandKeyIsF6 or CommandKeyIsF7
        accept SearchScreen from crt end-accept
        evaluate true
            when CommandKeyIsF2 perform ListAttendees
            when CommandKeyIsF5 perform SearchByAuthCode
            when CommandKeyIsF6 perform SearchByName
            when CommandKeyIsF7 perform SearchByEmail
        end-evaluate
    end-perform
 
    if RecordFound then
        perform EditAttendee
    end-if
.
 
SearchByAuthCode section.
    if AuthCodeToSearchFor is not HexNumber then
        exit section
    end-if
 
    search Attendee
        when upper-case(AuthCode of Attendee(AttendeeIndex)) is equal to upper-case(AuthCodeToSearchFor)
            perform SetCurrentAttendeeToFound
    end-search
.
 
SearchByName section.
    search Attendee
        when upper-case(Name of Attendee(AttendeeIndex)) is equal to upper-case(NameToSearchFor)
            perform SetCurrentAttendeeToFound
    end-search
.
 
SearchByEmail section.
    search Attendee
        when upper-case(Email of Attendee(AttendeeIndex)) is equal to upper-case(EmailToSearchFor)
            perform SetCurrentAttendeeToFound
    end-search
.
 
SetCurrentAttendeeToFound section.
    set CurrentAttendeeNumber to AttendeeIndex
    move Attendee(CurrentAttendeeNumber) to CurrentAttendee
    set RecordFound to true
.
 
end program BAMS.
 

For the rest of the code listings, refer to the GitHub project page for BAMS.

Resources

• Gnu COBOL FAQ is an excellent source of documentation about Gnu COBOL and has lots of interesting and often funny comments and facts about it
• Michael Coghlan's excellent Beginning COBOL for Programmers is a great book that has good exercises, is very irreverent about COBOL and programming in general, and is full of insights into both
• My GitHub page has a number of kata solutions in COBOL, as well as the code for my simple library for doing test driven development in GNU COBOL