IDENTIFICATION DIVISION. PROGRAM-ID. APPLENTRY. AUTHOR. MIKE GALLANT. * This purpose of this program is to enter new credit card applicants into * the credit card system. Each field is prompted for and then the user * is asked if they wish to make any changes to the fields. If not, then * they are prompted for confirmation to write the record to file. If there * are changes to be made, each field can be changed by entering the number * beside each field. The Account Number is automatically assigned and * cannot be entered or edited. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. ALPHA. OBJECT-COMPUTER. ALPHA. SPECIAL-NAMES. * To declare an AlphaNumeric datatype to check the Street Address CLASS AN-NUMERIC IS " ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789". INPUT-OUTPUT SECTION. FILE-CONTROL. COPY "SELECT_CLIENT.LIB". COPY "SELECT_SEARTON.LIB". DATA DIVISION. FILE SECTION. COPY "FD_CLIENT.LIB". COPY "FD_SEARTON.LIB". WORKING-STORAGE SECTION. COPY "CLIENTREADIN.LIB". COPY "SEARTONREADIN.LIB". * The following entries are all used to display field names * and headings on the screen 01 HEADING1 PIC X(28) VALUE "SEARTON'S CHARGE CARD SYSTEM". 01 HEADING2 PIC X(24) VALUE "APPLICATION ENTRY SCREEN". 01 INFO1. 05 FILLER PIC X(20) VALUE "1. Client Last Name:". 05 FILLER PIC X(22) VALUE SPACES. 05 FILLER PIC X(10) VALUE "4. Street:". 01 INFO2. 05 FILLER PIC X(14) VALUE "2. First Name:". 05 FILLER PIC X(22) VALUE SPACES. 05 FILLER PIC X(08) VALUE "5. City:". 01 INFO3. 05 FILLER PIC X(11) VALUE "3. Initial:". 05 FILLER PIC X(22) VALUE SPACES. 05 FILLER PIC X(09) VALUE "6. Prov.:". 01 INFO4 PIC X(15) VALUE "7. Postal Code:". 01 INFO5 PIC X(14) VALUE "8. Home Phone:". 01 INFO6. 05 FILLER PIC X(14) VALUE "9. Work Phone:". 05 FILLER PIC X(28) VALUE SPACES. 05 FILLER PIC X(18) VALUE "11. Language Code:". 01 INFO7. 05 FILLER PIC X(11) VALUE "10. D.O.B.:". 05 FILLER PIC X(02) VALUE SPACES. 05 FILLER PIC X VALUE "/". 05 FILLER PIC X(03) VALUE " /". 01 INFO8. 05 FILLER PIC X(21) VALUE "12. Second Last Name:". 05 FILLER PIC X(21) VALUE SPACES. 05 FILLER PIC X(14) VALUE "Account Id:". 01 INFO9. 05 FILLER PIC X(15) VALUE "13. First Name:". 01 INFO10 PIC X(12) VALUE "14. Initial:". * These fields are used so that COBOL will make the proper conversion to * packed-decimal and binary when writing these values to file 01 TO-FILE-FIELDS. 05 F-DATE-OF-BIRTH PIC 9(08). 05 F-HOME-PHONE PIC 9(10). 05 F-WORK-PHONE PIC 9(10). 05 F-POSTAL-CODE PIC X(06). * This field is used to test character fields for leading spaces and junk * characters 01 V-FIELDS. 05 V-TEST-FIELD PIC X(18). * Used to accept input from user before moving the data to file 01 OUTPUT-FIELDS. 05 O-ACTUAL-CRD-LIMIT PIC 9(10). 05 O-CREDIT-LIMIT PIC 9(10). 88 A-VALID-CREDIT-LIMIT VALUES 50 THRU 500000. 05 O-LANG-CODE PIC X. 88 VALID-CODES VALUES "E" "F" "S". 05 O-PREF-LANGUAGE PIC X(10). 05 O-ACCOUNT-ID PIC 9(10). 05 O-CARDS-ISSUED PIC 9(01). 05 O-LAST-PAY-DATE PIC 9999/99/99. 05 O-DATE-OF-BIRTH. 10 BIRTH-YEAR PIC 9(04). 10 BIRTH-MONTH PIC 9(02). 10 BIRTH-DAY PIC 9(02). 05 O-STATEMENT-DAY PIC 9(02). 05 O-HOME-PHONE. 10 H-AREA-CODE PIC X(03). 10 H-EXTENSION PIC X(03). 10 H-NUMBER PIC X(04). 05 O-WORK-PHONE. 10 W-AREA-CODE PIC X(03). 10 W-EXTENSION PIC X(03). 10 W-NUMBER PIC X(04). 05 O-POSTAL-CODE. 10 POSTAL-ONE PIC X. 10 POSTAL-TWO PIC 9. 10 POSTAL-THREE PIC X. 10 POSTAL-FOUR PIC 9. 10 POSTAL-FIVE PIC X. 10 POSTAL-SIX PIC 9. COPY "WORKDATE.LIB". COPY "ALPHABET.LIB". 01 PROMPT PIC X(09) VALUE "OK (Y/N):". * Used to check Character Key Fields to see that they are not left blank 01 SPACE-CHECK PIC X(40) VALUE SPACES. * Used to validate the Postal Code in X9X-9X9 format 01 GET-POSTAL PIC X VALUE SPACE. 88 ATHRUZ VALUES "A" THRU "Z". 88 ZTHRU9 VALUES "0" THRU "9". 01 POSTAL-LINE PIC 9(02) VALUE ZEROES. 01 POSTAL-LINE2 PIC 9(02) VALUE ZEROES. * To accept field number that person wants to edit 01 FIELD-TO-CHANGE PIC 9(02) VALUE ZEROES. * To validate date for Leap Year 01 LEAP-YEAR-STUFF. 05 LEAP-YEAR PIC 9(02) VALUE ZEROES. 05 SPEC-LEAP-YEAR PIC 9(02) VALUE ZEROES. 01 FLAGZ. 05 OK-FLAG PIC X VALUE "N". 05 CHANGE-FLAG PIC X VALUE "Y". 88 NO-MORE-CHANGES VALUE "N". 88 MORE-ENTRY VALUE "Y". 05 GO-FLAG PIC X VALUE "Y". 88 OKAY VALUE "Y". 88 NOT-OKAY VALUE "N". 05 JUNK-FLAG PIC X VALUE "N". 88 IT-IS-JUNK VALUE "Y". 88 NOT-JUNK VALUE "N". 05 EOF-FLAG PIC X(01) VALUE "N". 01 WROTE-MESSAGE PIC X(57) VALUE "Name(s) and Address have been written to the Client File.". * To pause the screen to allow person to view messages 01 STOPPER PIC X(02) VALUE SPACES. * To count leading spaces in Character Fields 01 SPACE-COUNT PIC 9(02) VALUE ZEROS. * To count number of Illegal characters in fields 01 JUNK-COUNTER PIC 9(02) VALUE ZEROES. * To pause the user screen to allow viewing of messages before they are cleared 01 DELAY COMP-1. PROCEDURE DIVISION. MAINLINE. PERFORM INITIALIZATION. PERFORM MAIN-PROGRAM UNTIL NOT-OKAY. PERFORM TERMINATION. STOP RUN. INITIALIZATION. OPEN I-O CLIENT-FILE SEARTONS-WORK. COPY "INITDATE.LIB". READ SEARTONS-WORK INTO SEARTON-READ-IN AT END DISPLAY " " LINE 1 COLUMN 1. * Moves Next Account Id in Work File to Output Field MOVE N-ACCOUNT-ID TO O-ACCOUNT-ID. * Display all Initial Headings, Titles & Field Names on the screen DISPLAY SPACES LINE 1 ERASE TO END OF SCREEN. DISPLAY HEADING1 LINE 3 COLUMN 30. DISPLAY HEADING2 LINE 5 COLUMN 31. DISPLAY INFO1 LINE 7 COLUMN 5. DISPLAY INFO2 LINE 8 COLUMN 11. DISPLAY INFO3 LINE 9 COLUMN 14. DISPLAY INFO4 LINE 10 COLUMN 47. DISPLAY INFO5 LINE 11 COLUMN 5. DISPLAY INFO6 LINE 12 COLUMN 5. DISPLAY INFO7 LINE 14 COLUMN 5. DISPLAY INFO8 LINE 16 COLUMN 5. DISPLAY INFO9 LINE 17 COLUMN 11. DISPLAY INFO10 LINE 18 COLUMN 14. DISPLAY "(" LINE 11 COLUMN 25. DISPLAY ")" LINE 11 COLUMN 29. DISPLAY "-" LINE 11 COLUMN 34. DISPLAY "(" LINE 12 COLUMN 25. DISPLAY ")" LINE 12 COLUMN 29. DISPLAY "-" LINE 12 COLUMN 34. MAIN-PROGRAM. MOVE "Y" TO GO-FLAG. MOVE "Y" TO CHANGE-FLAG. PERFORM GET-TIME-DATE. PERFORM CLEAR-THE-SCREEN. DISPLAY SPACES LINE 23 ERASE TO END OF LINE. ADD 3 TO O-ACCOUNT-ID. MOVE O-ACCOUNT-ID TO IDX-ACCOUNT-ID. * To make sure that the Account Id assigned is already on file READ CLIENT-FILE INTO CLIENT-READ-IN INVALID KEY PERFORM GET-CREDIT-DATA UNTIL CHANGE-FLAG = "N" NOT INVALID KEY DISPLAY "Duplicate Account ID" LINE 22 COLUMN 30 END-READ. DISPLAY SPACES LINE 22 ERASE TO END OF LINE. DISPLAY "Add Another Client (Y/N)" LINE 22 COLUMN 20. ACCEPT GO-FLAG LINE 22 COLUMN 45 PROTECTED DEFAULT "N". INSPECT GO-FLAG CONVERTING LOWER-CASE TO UPPER-CASE. DISPLAY SPACES LINE 22 ERASE TO END OF SCREEN. * To remove previous data from screen to allow for next entry CLEAR-THE-SCREEN. PERFORM VARYING SPACE-COUNT FROM 27 BY 1 UNTIL SPACE-COUNT = 46 DISPLAY SPACES LINE 8 COLUMN SPACE-COUNT END-PERFORM. PERFORM VARYING SPACE-COUNT FROM 27 BY 1 UNTIL SPACE-COUNT = 43 DISPLAY SPACES LINE 7 COLUMN SPACE-COUNT END-PERFORM. PERFORM VARYING SPACE-COUNT FROM 27 BY 1 UNTIL SPACE-COUNT = 33 DISPLAY SPACES LINE 9 COLUMN SPACE-COUNT END-PERFORM. PERFORM VARYING SPACE-COUNT FROM 27 BY 1 UNTIL SPACE-COUNT = 49 DISPLAY SPACES LINE 17 COLUMN SPACE-COUNT END-PERFORM. PERFORM VARYING SPACE-COUNT FROM 27 BY 1 UNTIL SPACE-COUNT = 43 DISPLAY SPACES LINE 16 COLUMN SPACE-COUNT END-PERFORM. PERFORM VARYING SPACE-COUNT FROM 27 BY 1 UNTIL SPACE-COUNT = 33 DISPLAY SPACES LINE 18 COLUMN SPACE-COUNT END-PERFORM. PERFORM VARYING SPACE-COUNT FROM 7 BY 1 UNTIL SPACE-COUNT = 10 DISPLAY SPACES LINE SPACE-COUNT COLUMN 59 ERASE TO END OF LINE END-PERFORM. DISPLAY SPACES LINE 10 COLUMN 63 ERASE TO END OF LINE. PERFORM VARYING SPACE-COUNT FROM 17 BY 1 UNTIL SPACE-COUNT = 28 DISPLAY SPACES LINE 14 COLUMN SPACE-COUNT END-PERFORM. PERFORM VARYING SPACE-COUNT FROM 21 BY 1 UNTIL SPACE-COUNT = 36 DISPLAY SPACES LINE 11 COLUMN SPACE-COUNT END-PERFORM. PERFORM VARYING SPACE-COUNT FROM 21 BY 1 UNTIL SPACE-COUNT = 36 DISPLAY SPACES LINE 12 COLUMN SPACE-COUNT END-PERFORM. DISPLAY SPACES LINE 12 COLUMN 65 ERASE TO END OF LINE. PERFORM VARYING SPACE-COUNT FROM 11 BY 1 UNTIL SPACE-COUNT = 13 DISPLAY "(" LINE SPACE-COUNT COLUMN 21 DISPLAY ")" LINE SPACE-COUNT COLUMN 25 DISPLAY "-" LINE SPACE-COUNT COLUMN 30 END-PERFORM. DISPLAY "-" LINE 10 COLUMN 66. DISPLAY "/" LINE 14 COLUMN 22. DISPLAY "/" LINE 14 COLUMN 25. COPY "TIMEDATE.LIB". COPY "JUNK-CHECK.LIB". COPY "AN-JUNK-CHECK.LIB". * To prevent key fields from having a "Blank" Entry BLANK-CHECK. IF SPACE-CHECK = SPACES THEN MOVE "N" TO GO-FLAG ELSE MOVE "Y" TO GO-FLAG DISPLAY SPACES LINE 22 ERASE TO END OF LINE END-IF. MOVE SPACES TO SPACE-CHECK. * Initializes Output fields so that the previous customers data is not stored * in the next customers information CLEAR-OUTPUT-FIELDS. MOVE SPACES TO ACCOUNT-STATUS. MOVE ZEROES TO ISSUE-DATE. MOVE ZEROES TO EXPIRY-DATE. MOVE ZEROES TO CARDS-ISSUED. MOVE SPACES TO PRIMARY-FIRST-NAME. MOVE SPACES TO PRIMARY-LAST-NAME. MOVE SPACES TO PRIMARY-MID-INIT. MOVE SPACES TO SECOND-FIRST-NAME. MOVE SPACES TO SECOND-LAST-NAME. MOVE SPACES TO SECOND-MID-INIT. MOVE ZEROES TO STATEMENT-DAY. MOVE ZEROES TO PREV-BALANCE. MOVE ZEROES TO CURRENT-BALANCE. MOVE ZEROES TO TOTAL-PAYMENTS. MOVE ZEROES TO TOTAL-PURCHASES. MOVE ZEROES TO LAST-PAY-DATE. MOVE ZEROES TO LAST-PURCH-DATE. MOVE ZEROES TO MIN-PAY-DUE. MOVE ZEROES TO CREDIT-LIMIT. MOVE ZEROES TO ACTUAL-CRD-LIMIT. MOVE SPACES TO STREET. MOVE SPACES TO CITY. MOVE SPACES TO PROVINCE. MOVE SPACES TO POSTAL-ONE. MOVE ZEROES TO POSTAL-TWO. MOVE SPACES TO POSTAL-THREE. MOVE ZEROES TO POSTAL-FOUR. MOVE SPACES TO POSTAL-FIVE. MOVE ZEROES TO POSTAL-SIX. MOVE SPACES TO LANG-CODE. MOVE ZEROES TO LAST-CONTACT-DATE. MOVE ZEROES TO WORK-PHONE. MOVE ZEROES TO HOME-PHONE. MOVE ZEROES TO INTEREST-OWED. MOVE ZEROES TO DATE-OF-BIRTH. MOVE ZEROES TO BIRTH-YEAR. MOVE ZEROES TO BIRTH-MONTH. MOVE ZEROES TO BIRTH-DAY. * Initializes Flags so that they can be used again RESET-FLAGS. MOVE "N" TO GO-FLAG. MOVE "Y" TO JUNK-FLAG. * Heart & Soul of program -- Gets all the Client Information & validates * it at the same time GET-CREDIT-DATA. PERFORM CLEAR-OUTPUT-FIELDS. MOVE O-ACCOUNT-ID TO ACCOUNT-ID. DISPLAY O-ACCOUNT-ID LINE 16 COLUMN 59. PERFORM RESET-FLAGS. DISPLAY "Hit To Cancel Application Entry" LINE 22 COLUMN 18. PERFORM GET-PRIMARY-LAST-NAME UNTIL OKAY AND NOT-JUNK. DISPLAY SPACES LINE 22 ERASE TO END OF LINE. IF MORE-ENTRY THEN PERFORM RESET-FLAGS PERFORM GET-PRIMARY-FIRST-NAME UNTIL OKAY AND NOT-JUNK PERFORM RESET-FLAGS PERFORM GET-PRIMARY-MID-INIT UNTIL NOT-JUNK PERFORM RESET-FLAGS PERFORM GET-STREET UNTIL OKAY AND NOT-JUNK PERFORM RESET-FLAGS PERFORM GET-CITY UNTIL OKAY AND NOT-JUNK PERFORM RESET-FLAGS PERFORM GET-PROVINCE UNTIL OKAY PERFORM RESET-FLAGS PERFORM GET-POSTAL-CODE PERFORM RESET-FLAGS PERFORM GET-HOME-PHONE DISPLAY "Hit to default to Home Phone Number" LINE 22 COLUMN 17 PERFORM GET-WORK-PHONE DISPLAY SPACES LINE 22 ERASE TO END OF LINE PERFORM GET-DATE-OF-BIRTH PERFORM RESET-FLAGS MOVE "E" TO LANG-CODE PERFORM GET-LANGUAGE-CODE UNTIL OKAY PERFORM RESET-FLAGS DISPLAY "Hit to Skip Secondary Card Holder" LINE 22 COLUMN 19 PERFORM GET-SECOND-LAST-NAME UNTIL NOT-JUNK DISPLAY SPACES LINE 22 ERASE TO END OF LINE * Check to see if Operator is entering Supplementary Card Holder IF SECOND-LAST-NAME NOT EQUAL SPACES THEN PERFORM RESET-FLAGS PERFORM GET-SECOND-FIRST-NAME UNTIL OKAY AND NOT-JUNK MOVE 2 TO CARDS-ISSUED PERFORM RESET-FLAGS PERFORM GET-SECOND-MID-INIT UNTIL NOT-JUNK END-IF PERFORM INIT-FIELDS * This prompt is used to ask operator if information entered is correct DISPLAY PROMPT LINE 20 COLUMN 36 ACCEPT OK-FLAG LINE 20 COLUMN 46 PROTECTED DEFAULT "N" INSPECT OK-FLAG CONVERTING LOWER-CASE TO UPPER-CASE IF OK-FLAG = "Y" THEN PERFORM WRITE-TO-FILE ELSE PERFORM MAKE-OR-CANCEL END-IF END-IF. MAKE-OR-CANCEL. DISPLAY "(M)ake Changes or (C)ancel Request:" LINE 20 COLUMN 25. ACCEPT OK-FLAG LINE 20 COLUMN 61 PROTECTED WITH NO BLANK DEFAULT "C". INSPECT OK-FLAG CONVERTING LOWER-CASE TO UPPER-CASE. IF OK-FLAG = "M" THEN PERFORM CHANGE-INFO UNTIL NO-MORE-CHANGES DISPLAY SPACES LINE 22 ERASE TO END OF LINE DISPLAY "Write to File (Y/N)" LINE 22 COLUMN 20 ACCEPT OK-FLAG LINE 22 COLUMN 40 PROTECTED DEFAULT "N" INSPECT OK-FLAG CONVERTING LOWER-CASE TO UPPER-CASE IF OKAY THEN PERFORM WRITE-TO-FILE END-IF ELSE MOVE "N" TO CHANGE-FLAG END-IF. INIT-FIELDS. * To set account to Pending Approval MOVE "P" TO ACCOUNT-STATUS. MOVE F-SYS-DATE TO ISSUE-DATE, LAST-CONTACT-DATE, LAST-PAY-DATE, LAST-PURCH- DATE. * To set expiry date of Credit Card ADD 2 TO SYS-YEAR. MOVE SYS-DATE TO F-SYS-DATE. MOVE F-SYS-DATE TO EXPIRY-DATE. * Set Date back to current date SUBTRACT 2 FROM SYS-YEAR. MOVE SYS-DATE TO F-SYS-DATE. MOVE 14 TO STATEMENT-DAY. MOVE 1000 TO CREDIT-LIMIT. MOVE 100000 TO ACTUAL-CRD-LIMIT. IF CARDS-ISSUED = 0 THEN MOVE 1 TO CARDS-ISSUED. PERFORM CLEAR-20. WRITE-TO-FILE. MOVE "N" TO CHANGE-FLAG. WRITE CLIENT-KEYS FROM CLIENT-READ-IN INVALID KEY DISPLAY "NO WRITE" LINE 20 COLUMN 6. COPY "CLEAR-20.LIB". COPY "PRIMARY-NAMES.LIB". COPY "SECOND-NAMES.LIB". COPY "ADDRESS-INFO.LIB". COPY "PHONE-NUMBERS.LIB". COPY "BIRTH-DAY.LIB". COPY "LANGUAGE-CODE.LIB". COPY "POSTAL-CODE.LIB". COPY "CHANGE-INFO2.LIB". TERMINATION. DISPLAY SPACES LINE 23 ERASE TO END OF LINE. DISPLAY "" LINE 23 COLUMN 30. ACCEPT STOPPER LINE 23 COLUMN 50. * Rewrite next unused Account Id to Seartons Work file MOVE O-ACCOUNT-ID TO N-ACCOUNT-ID. REWRITE SEARTONS-WORK-FILE FROM SEARTON-READ-IN. CLOSE CLIENT-FILE SEARTONS-WORK.