PCDO @SEARTONSBACK >[?21h CREATE DICTIONARY SEARTONS ELEMENT BRANCH-ID C 4 & PATTERN "^^^#" ELEMENT BRANCH-NAME C 18 ELEMENT BRANCH-PROV C 2 & PATTERN "^^" ELEMENT ACCOUNT-ID C 10 ELEMENT N-ACCOUNT-ID N 10 ELEMENT ACCOUNT-STATUS C 2 & VALUE "A" CAPTION "ACTIVE" ELEMENT ISSUE-DATE N 8 ELEMENT EXPIRY-DATE N 8 ELEMENT CARDS-ISSUED N 2 ELEMENT PRIMARY-FIRST-NAME C 18 ELEMENT PRIMARY-LAST-NAME C 12 ELEMENT PRIMARY-MID-INIT C 2 ELEMENT PRIMARY-CARD-HOLDER C 32 ELEMENT SECOND-FIRST-NAME C 18 ELEMENT SECOND-LAST-NAME C 12 ELEMENT SECOND-MID-INIT C 2 ELEMENT SECOND-CARD-HOLDER C 32 ELEMENT STATEMENT-DAY N 2 ELEMENT PREV-BALANCE N 12 ELEMENT CURRENT-BALANCE N 12 ELEMENT TOTAL-PAYMENTS N 12 ELEMENT TOTAL-PURCHASES N 12 ELEMENT LAST-PAY-DATE N 8 ELEMENT LAST-PURCH-DATE N 8 ELEMENT MIN-PAY-DUE N 12 & PICTURE "$^,^^^,^^^,^^^.^^" ELEMENT CREDIT-LIMIT N 12 & PICTURE "$^,^^^,^^^,^^^" ELEMENT ACTUAL-CRD-LIMIT N 12 ELEMENT STREET C 18 ELEMENT CITY C 18 ELEMENT PROVINCE C 2 ELEMENT POSTAL-CODE C 6 ELEMENT CARD-HOLDER-ADDRESS C 44 ELEMENT LANG-CODE C 2 ELEMENT LAST-CONTACT-DATE N 8 ELEMENT WORK-PHONE N 10 ELEMENT HOME-PHONE N 10 & PICTURE "(^^^) ^^^-^^^^" SIGNIFICANCE 14 ELEMENT INTEREST-OWED N 12 ELEMENT DATE-OF-BIRTH N 8 & PICTURE "^^^^-^^-^^" SIGNIFICANCE 10 ELEMENT PAYMENT-DATE C 8 ELEMENT PAYMENT-TIME C 6 ELEMENT PAYMENT-AMT N 12 ELEMENT PAYMENT-TYPE C 2 ELEMENT REFERENCE-ID C 4 ELEMENT YEAR-MONTH N 6 ELEMENT TOT-MON-PAY N 12 ELEMENT TOT-MON-SALE N 12 ELEMENT SALE-DATE C 8 ELEMENT SALE-TIME C 6 ELEMENT SALES-SLIP-NBR N 8 ELEMENT PURCHASE-AMT N 12 ELEMENT AUTH-NBR N 8 ELEMENT RETURN-NBR N 4 ELEMENT INT-RATE N 4 ELEMENT RETURN-DATE C 8 ELEMENT RETURN-TIME C 6 ELEMENT RETURN-AMT N 12 ELEMENT RETURN-KEY C 24 ELEMENT BRANCH-FILLER C 232 ELEMENT ACCOUNT-FILLER C 246 ELEMENT CLIENT-FILLER C 42 ELEMENT PAYMENT-FILLER C 214 ELEMENT SALE-FILLER C 214 ELEMENT RETURN-FILLER C 218 ELEMENT SEARTON-FILLER C 236 ELEMENT SUMMARY-FILLER C 240 ELEMENT PAYMENT-KEY C 24 ELEMENT SALES-KEY C 24 FILE BRANCH-INFO ORGANIZATION INDEXED RECORD BRANCH-INFO ITEM BRANCH-ID DATATYPE CHAR ITEM BRANCH-NAME DATATYPE CHAR ITEM BRANCH-PROV DATATYPE CHAR ITEM BRANCH-FILLER DATATYPE CHAR INDEX BRANCH-ID UNIQUE SEGMENT BRANCH-ID FILE CLIENT ORGANIZATION INDEXED RECORD CLIENT ITEM ACCOUNT-ID DATATYPE CHAR ITEM ACCOUNT-STATUS DATATYPE CHAR ITEM ISSUE-DATE DATATYPE INTEGER SIGNED SIZE 4 ITEM EXPIRY-DATE DATATYPE INTEGER SIGNED SIZE 4 ITEM CARDS-ISSUED DATATYPE INTEGER SIGNED SIZE 4 ITEM PRIMARY-CARD-HOLDER BEGIN STRUCTURE ITEM PRIMARY-LAST-NAME DATATYPE CHAR ITEM PRIMARY-FIRST-NAME DATATYPE CHAR ITEM PRIMARY-MID-INIT DATATYPE CHAR END STRUCTURE ITEM SECOND-CARD-HOLDER BEGIN STRUCTURE ITEM SECOND-LAST-NAME DATATYPE CHAR ITEM SECOND-FIRST-NAME DATATYPE CHAR ITEM SECOND-MID-INIT DATATYPE CHAR END STRUCTURE ITEM STATEMENT-DAY DATATYPE INTEGER SIGNED SIZE 4 ITEM PREV-BALANCE DATATYPE PACKED SIZE 6 ITEM CURRENT-BALANCE DATATYPE PACKED SIZE 6 ITEM TOTAL-PAYMENTS DATATYPE PACKED SIZE 6 ITEM TOTAL-PURCHASES DATATYPE PACKED SIZE 6 ITEM LAST-PAY-DATE DATATYPE INTEGER SIGNED SIZE 4 ITEM LAST-PURCH-DATE DATATYPE INTEGER SIGNED SIZE 4 ITEM MIN-PAY-DUE DATATYPE PACKED SIZE 6 ITEM CREDIT-LIMIT DATATYPE PACKED SIZE 6 ITEM ACTUAL-CRD-LIMIT DATATYPE PACKED SIZE 6 ITEM CARD-HOLDER-ADDRESS BEGIN STRUCTURE ITEM STREET DATATYPE CHAR ITEM CITY DATATYPE CHAR ITEM PROVINCE DATATYPE CHAR ITEM POSTAL-CODE DATATYPE CHAR END STRUCTURE ITEM LANG-CODE DATATYPE CHAR ITEM LAST-CONTACT-DATE DATATYPE INTEGER SIGNED SIZE 4 ITEM WORK-PHONE DATATYPE PACKED SIZE 6 ITEM HOME-PHONE DATATYPE PACKED SIZE 6 ITEM INTEREST-OWED DATATYPE PACKED SIZE 6 ITEM DATE-OF-BIRTH DATATYPE INTEGER SIGNED SIZE 4 ITEM CLIENT-FILLER DATATYPE CHAR INDEX ACCOUNT-ID UNIQUE SEGMENT ACCOUNT-ID INDEX ACCOUNT-STATUS REPEATING SEGMENT ACCOUNT-STATUS INDEX ISSUE-DATE REPEATING SEGMENT ISSUE-DATE INDEX EXPIRY-DATE REPEATING SEGMENT EXPIRY-DATE INDEX PRIMARY-CARD-HOLDER REPEATING SEGMENT PRIMARY-CARD-HOLDER INDEX STATEMENT-DAY REPEATING SEGMENT STATEMENT-DAY INDEX LAST-PAY-DATE REPEATING SEGMENT LAST-PAY-DATE INDEX LAST-PURCH-DATE REPEATING SEGMENT LAST-PURCH-DATE INDEX CARD-HOLDER-ADDRESS REPEATING SEGMENT CARD-HOLDER-ADDRESS FILE PAYMENT-TRANSACTION ORGANIZATION INDEXED RECORD PAYMENT-TRANSACTION ITEM PAYMENT-KEY BEGIN STRUCTURE ITEM ACCOUNT-ID DATATYPE CHAR ITEM PAYMENT-DATE DATATYPE CHAR ITEM PAYMENT-TIME DATATYPE CHAR END STRUCTURE ITEM BRANCH-ID DATATYPE CHAR ITEM PAYMENT-TYPE DATATYPE CHAR ITEM REFERENCE-ID DATATYPE CHAR ITEM BRANCH-PROV DATATYPE CHAR ITEM PAYMENT-AMT DATATYPE PACKED SIZE 6 ITEM PAYMENT-FILLER DATATYPE CHAR INDEX PAYMENT-KEY UNIQUE SEGMENT PAYMENT-KEY INDEX BRANCH-ID REPEATING SEGMENT BRANCH-ID INDEX BRANCH-PROV REPEATING SEGMENT BRANCH-PROV FILE PAYMENT-TRANS-SUMMARY ORGANIZATION INDEXED RECORD PAYMENT-TRANS-SUMMARY ITEM BRANCH-ID DATATYPE CHAR ITEM YEAR-MONTH DATATYPE INTEGER SIGNED SIZE 4 ITEM TOT-MON-PAY DATATYPE PACKED SIZE 6 ITEM BRANCH-PROV DATATYPE CHAR ITEM SUMMARY-FILLER DATATYPE CHAR INDEX BRANCH-ID REPEATING SEGMENT BRANCH-ID INDEX YEAR-MONTH REPEATING SEGMENT YEAR-MONTH FILE SALES-TRANSACTION ORGANIZATION INDEXED RECORD SALES-TRANSACTION ITEM SALES-KEY BEGIN STRUCTURE ITEM ACCOUNT-ID DATATYPE CHAR ITEM SALE-DATE DATATYPE CHAR ITEM SALE-TIME DATATYPE CHAR END STRUCTURE ITEM BRANCH-ID DATATYPE CHAR ITEM SALES-SLIP-NBR DATATYPE INTEGER SIGNED SIZE 4 ITEM AUTH-NBR DATATYPE INTEGER SIGNED SIZE 4 ITEM PURCHASE-AMT DATATYPE PACKED SIZE 6 ITEM SALE-FILLER DATATYPE CHAR INDEX SALES-KEY UNIQUE SEGMENT SALES-KEY INDEX BRANCH-ID REPEATING SEGMENT BRANCH-ID FILE SALES-TRANS-SUMMARY ORGANIZATION INDEXED RECORD SALES-TRANS-SUMMARY ITEM BRANCH-ID DATATYPE CHAR ITEM YEAR-MONTH DATATYPE INTEGER SIGNED SIZE 4 ITEM TOT-MON-SALE DATATYPE PACKED SIZE 6 ITEM BRANCH-PROV DATATYPE CHAR ITEM SUMMARY-FILLER DATATYPE CHAR INDEX BRANCH-ID REPEATING SEGMENT BRANCH-ID INDEX YEAR-MONTH REPEATING SEGMENT YEAR-MONTH INDEX BRANCH-PROV REPEATING SEGMENT BRANCH-PROV FILE SEARTONS-WORK ORGANIZATION SEQUENTIAL RECORD SEARTONS-WORK ITEM SALES-SLIP-NBR DATATYPE INTEGER SIGNED SIZE 4 ITEM AUTH-NBR DATATYPE INTEGER SIGNED SIZE 4 ITEM RETURN-NBR DATATYPE INTEGER SIGNED SIZE 4 ITEM INT-RATE DATATYPE INTEGER SIGNED SIZE 4 ITEM N-ACCOUNT-ID DATATYPE INTEGER SIGNED SIZE 4 ITEM SEARTON-FILLER DATATYPE CHAR FILE RETURNS ORGANIZATION INDEXED RECORD RETURNS ITEM RETURN-KEY BEGIN STRUCTURE ITEM ACCOUNT-ID DATATYPE CHAR ITEM RETURN-DATE DATATYPE CHAR ITEM RETURN-TIME DATATYPE CHAR END STRUCTURE ITEM BRANCH-ID DATATYPE CHAR ITEM RETURN-NBR DATATYPE INTEGER SIGNED SIZE 4 ITEM RETURN-AMT DATATYPE PACKED SIZE 6 ITEM RETURN-FILLER DATATYPE CHAR INDEX RETURN-KEY UNIQUE SEGMENT RETURN-KEY INDEX BRANCH-ID REPEATING SEGMENT BRANCH-ID INDEX RETURN-NBR UNIQUE SEGMENT RETURN-NBR FILE ACCOUNT-TEMP ORGANIZATION SEQUENTIAL RECORD ACCOUNT-TEMP ITEM ACCOUNT-ID DATATYPE CHAR ITEM ACCOUNT-FILLER DATATYPE CHAR LOAD >> [?21h IDENTIFICATION DIVISION. PROGRAM-ID. ACCEPTED. AUTHOR. MIKE GALLANT. * This program is to approve accepted clients and print out an acceptance * letter to which their credit card(s) will be attached. The Account Status * of the client is also set to Active at this time. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. ALPHA. OBJECT-COMPUTER. ALPHA. INPUT-OUTPUT SECTION. FILE-CONTROL. COPY "SELECT_CLIENT.LIB". SELECT PRINTER ASSIGN TO "ACCEPTED.LTR". DATA DIVISION. FILE SECTION. COPY "FD_CLIENT.LIB". FD PRINTER RECORD CONTAINS 80 CHARACTERS LABEL RECORDS OMITTED. 01 PRINT-LINE PIC X(80). WORKING-STORAGE SECTION. COPY "CLIENTREADIN.LIB". 01 HEADING1 PIC X(28) VALUE "SEARTON'S CHARGE CARD SYSTEM". 01 HEADING2 PIC X(20) VALUE "ACCEPTED APPLICATION". 01 INFO2 PIC X(18) VALUE "Client Account Id:". 01 OTHER-INFO. 05 D-PRIMARY PIC X(05) VALUE "Name:". 05 D-STREET PIC X(07) VALUE "Street:". 05 D-CITY PIC X(05) VALUE "City:". 05 D-PROV PIC X(06) VALUE "Prov.:". 05 D-POSTAL PIC X(12) VALUE "Postal Code:". 01 PROMPT PIC X(09) VALUE "OK (Y/N):". 01 DISPLAY-MESSAGES. 05 NOW-ACTIVE-MESSAGE PIC X(30) VALUE "Customer Status is now active.". 05 PRINTING-MESSAGE PIC X(39) VALUE "Acceptance Letter is now being printed.". 05 SEARCH-MESSAGE PIC X(29) VALUE "Searching for Client Name....". 05 NO-MATCH-MESSAGE PIC X(22) VALUE "No match found on file". 05 CORRECT-MESSAGE PIC X(34) VALUE "Is this the correct account? (Y/N)". 05 ANY-KEY-MESSAGE PIC X(21) VALUE "". 01 OUTPUT-LINE. 05 O-PRIMARY-LAST-NAME PIC X(12). 05 FILLER PIC X(02) VALUE SPACES. 05 O-STREET PIC X(18). 05 FILLER PIC X(02) VALUE SPACES. 05 O-CITY PIC X(18). 05 FILLER PIC X(02) VALUE SPACES. 05 O-PROVINCE PIC X(02). 05 FILLER PIC X(02) VALUE SPACES. 05 O-POSTAL-CODE PIC X(06). 01 FLAGZ. * Is used to detect end of file 05 EOF-FLAG PIC X VALUE "N". 88 EOF VALUE "Y". * Is used to allow user exit from this program 05 EXIT-FLAG PIC X VALUE "N". 88 EXIT-NOW VALUE "Y". 88 EXIT-LATER VALUE "N". * Is used to determine if Account selected is the one to be accepted 05 WRITE-FLAG PIC X VALUE "N". 88 WRITE-IT VALUE "Y". 88 DONT-WRITE-IT VALUE "N". * To indicate if Account Id entered was found on file 05 MATCH-FLAG PIC X VALUE "N". 88 A-MATCH VALUE "Y". 88 NOT-A-MATCH VALUE "N". * To accept Account Id from user 01 S-ACCOUNT-ID PIC 9(10) VALUE ZEROES. * To pause the screen to allow user to view messages 01 DELAY COMP-1. * To display card holders name in compact format 01 PRIMARY-USER-NAME PIC X(32). COPY "ACCEPT_LETTER.LIB". COPY "WORKDATE.LIB". COPY "ALPHABET.LIB". PROCEDURE DIVISION. MAINLINE. PERFORM INITIALIZATION. PERFORM MAIN-PROGRAM UNTIL EXIT-NOW. PERFORM TERMINATION. STOP RUN. INITIALIZATION. MOVE "N" TO MATCH-FLAG. MOVE "N" TO WRITE-FLAG. MOVE "N" TO EXIT-FLAG. MOVE "N" TO EOF-FLAG. OPEN I-O CLIENT-FILE OUTPUT PRINTER. COPY "INITDATE.LIB". DISPLAY SPACES LINE 1 ERASE TO END OF SCREEN. DISPLAY HEADING1 LINE 3 COLUMN 29. DISPLAY HEADING2 LINE 5 COLUMN 35. DISPLAY INFO2 LINE 7 COLUMN 8. MAIN-PROGRAM. PERFORM GET-TIME-DATE. MOVE "N" TO EXIT-FLAG. DISPLAY SPACES LINE 8 ERASE TO END OF SCREEN. PERFORM GET-ACCOUNT-INFO. IF EXIT-LATER THEN PERFORM SEARCH-FOR-ACCOUNT-ID IF A-MATCH THEN PERFORM DISPLAY-ACCOUNT-DATA DISPLAY CORRECT-MESSAGE LINE 22 COLUMN 22 ACCEPT WRITE-FLAG LINE 22 COLUMN 57 PROTECTED DEFAULT "N" INSPECT WRITE-FLAG CONVERTING LOWER-CASE TO UPPER-CASE IF WRITE-IT THEN PERFORM WRITE-ACCEPTED-CLIENT DISPLAY ANY-KEY-MESSAGE LINE 23 COLUMN 29 END-IF END-IF END-IF. GET-ACCOUNT-INFO. DISPLAY "Type to exit" LINE 22 COLUMN 30. ACCEPT S-ACCOUNT-ID LINE 7 COLUMN 27 PROTECTED WITH CONVERSION DEFAULT ZEROES. DISPLAY SPACES LINE 22 ERASE TO END OF SCREEN. IF S-ACCOUNT-ID = ZEROES THEN MOVE "Y" TO EXIT-FLAG ELSE MOVE "N" TO EXIT-FLAG END-IF. SEARCH-FOR-ACCOUNT-ID. MOVE S-ACCOUNT-ID TO IDX-ACCOUNT-ID. MOVE "Y" TO MATCH-FLAG. READ CLIENT-FILE INTO CLIENT-READ-IN INVALID KEY PERFORM NOT-FOUND MOVE "N" TO MATCH-FLAG NOT INVALID KEY PERFORM CHECK-FOR-PENDING END-READ. CHECK-FOR-PENDING. IF ACCOUNT-STATUS NOT EQUAL "P" THEN MOVE "N" TO MATCH-FLAG DISPLAY "Account ID Entered is Invalid" LINE 22 COLUMN 10 MOVE 2 TO DELAY CALL "LIB$WAIT" USING BY REFERENCE DELAY END-IF. NOT-FOUND. DISPLAY NO-MATCH-MESSAGE LINE 22 COLUMN 10. MOVE 2 TO DELAY. CALL "LIB$WAIT" USING BY REFERENCE DELAY. DISPLAY-ACCOUNT-DATA. MOVE SPACES TO PRIMARY-USER-NAME. STRING PRIMARY-CARD-HOLDER(13:18) DELIMITED BY " " " " DELIMITED BY SIZE PRIMARY-CARD-HOLDER(31:2) DELIMITED BY " " " " DELIMITED BY SIZE PRIMARY-CARD-HOLDER(1:12) DELIMITED BY " " INTO PRIMARY-USER-NAME. DISPLAY D-PRIMARY LINE 10 COLUMN 15. DISPLAY D-STREET LINE 11 COLUMN 15. DISPLAY D-CITY LINE 12 COLUMN 15. DISPLAY D-PROV LINE 13 COLUMN 15. DISPLAY D-POSTAL LINE 14 COLUMN 15. DISPLAY PRIMARY-USER-NAME LINE 10 COLUMN 28. DISPLAY STREET LINE 11 COLUMN 28. DISPLAY CITY LINE 12 COLUMN 28. DISPLAY PROVINCE LINE 13 COLUMN 28. DISPLAY POSTAL-CODE LINE 14 COLUMN 28. COPY "TIMEDATE.LIB". WRITE-ACCEPTED-CLIENT. MOVE "A" TO ACCOUNT-STATUS. REWRITE CLIENT-KEYS FROM CLIENT-READ-IN INVALID KEY DISPLAY "Write could not be performed" LINE 22 COLUMN 10. DISPLAY "Customer Status is now active." LINE 17 COLUMN 15. DISPLAY "Acceptance Letter is now being printed" LINE 18 COLUMN 15. PERFORM PRINT-ACCEPTANCE-LETTER. MOVE 3 TO DELAY. CALL "LIB$WAIT" USING BY REFERENCE DELAY. COPY "ACCEPTED.LIB". TERMINATION. DISPLAY SPACES LINE 23 ERASE TO END OF LINE. DISPLAY "" LINE 23 COLUMN 30. ACCEPT EOF-FLAG LINE 23 COLUMN 50 PROTECTED. CLOSE CLIENT-FILE PRINTER. >> [?21h 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-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 "CREDIT-LIMIT.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-INFO.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. >> [?21h IDENTIFICATION DIVISION. PROGRAM-ID. APPLINQUIRE. 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. * This copy library is used to store a record that is read from the Client File COPY "CLIENTREADIN.LIB". * This copy library is used to store information that is read from the Seartons * work file COPY "SEARTONREADIN.LIB". 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-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. 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". 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. 01 TEMPDATE PIC 9(08) VALUE ZEROES. 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 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. * 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. 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. PERFORM GET-PRIMARY-LAST-NAME UNTIL OKAY AND NOT-JUNK. 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. PERFORM GET-WORK-PHONE. PERFORM GET-DATE-OF-BIRTH. PERFORM RESET-FLAGS. PERFORM GET-LANGUAGE-CODE UNTIL OKAY. PERFORM RESET-FLAGS. PERFORM GET-SECOND-LAST-NAME UNTIL NOT-JUNK. 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. * To set account to Pending Approval MOVE "P" TO ACCOUNT-STATUS. MOVE F-SYS-DATE TO ISSUE-DATE, LAST-CONTACT-DATE. MOVE F-SYS-DATE TO LAST-PAY-DATE. ACCEPT TEMPDATE LINE 23 COLUMN 6 PROTECTED WITH CONVERSION. MOVE TEMPDATE TO 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. 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. * 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 DISPLAY "(M)ake Changes or (C)ancel Request:" LINE 20 COLUMN 25 ACCEPT OK-FLAG LINE 20 COLUMN 61 PROTECTED 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 END-IF. 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 "CREDIT-LIMIT.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-INFO.LIB". TERMINATION. DISPLAY SPACES LINE 23 ERASE TO END OF LINE. DISPLAY "" LINE 23 COLUMN 30. ACCEPT STOPPER LINE 23 COLUMN 50. MOVE O-ACCOUNT-ID TO N-ACCOUNT-ID. REWRITE SEARTONS-WORK-FILE FROM SEARTON-READ-IN. CLOSE CLIENT-FILE SEARTONS-WORK. >> [?21h IDENTIFICATION DIVISION. PROGRAM-ID. CANCELLED. AUTHOR. MIKE GALLANT. * This program will set a Customer's account Status to Cancelled or Stolen * at the users request. If the customer wants their account cancelled and * have all future transactions disabled, then set Account Status to cancelled. * If a customer is reporting their card missing or stolen, set Account Status to stolen ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. ALPHA. OBJECT-COMPUTER. ALPHA. INPUT-OUTPUT SECTION. FILE-CONTROL. COPY "SELECT_CLIENT.LIB". DATA DIVISION. FILE SECTION. COPY "FD_CLIENT.LIB". WORKING-STORAGE SECTION. * This copy library is used to store a record that is read from the Client File COPY "CLIENTREADIN.LIB". * Headings used for this program 01 HEADING1 PIC X(28) VALUE "SEARTON'S CHARGE CARD SYSTEM". 01 HEADING2 PIC X(20) VALUE "CANCELLATION REQUEST". 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:". 05 FILLER PIC X(21) VALUE SPACES. 05 FILLER PIC X(07) VALUE "Status:". 01 INFO10. 05 FILLER PIC X(12) VALUE "14. Initial:". 05 FILLER PIC X(21) VALUE SPACES. 05 FILLER PIC X(16) VALUE "Current Balance:". 01 INFO11 PIC X(17) VALUE "15. Credit Limit:". 01 INFO12 PIC X(12) VALUE "Payment Due:". 01 PRE-INFO1. 05 FILLER PIC X(11) VALUE "Account Id:". * Fields that will displayed on the screen in a special format 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). * Tests for leading spaces and junk characters 01 V-FIELDS. 05 V-TEST-FIELD PIC X(18). * Used to accept input from operator or display output on screen 01 OUTPUT-FIELDS. 05 O-CURRENT-BALANCE PIC $$$,$$$,$$$.99. 05 O-MIN-PAY-DUE PIC $$$,$$$,$$$.99. 05 O-ACTUAL-CRD-LIMIT PIC $$$,$$$,$$$.99. 05 O-CREDIT-LIMIT PIC $$,$$$,$$$,$$$. 05 O-LANGUAGE-CODE PIC X(07). 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. 15 W-AREA-CODE1 PIC X. 15 W-AREA-CODE2 PIC X. 15 W-AREA-CODE3 PIC X. 10 W-EXTENSION. 15 W-EXTENSION1 PIC X. 15 W-EXTENSION2 PIC X. 15 W-EXTENSION3 PIC X. 10 W-NUMBER. 15 W-NUMBER1 PIC X. 15 W-NUMBER2 PIC X. 15 W-NUMBER3 PIC X. 15 W-NUMBER4 PIC X. 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. 05 O-STATUS PIC X(09). * Used to convert Lower Case Letters to Upper-Case 01 THE-ALPHABET. 05 LOWER-CASE PIC X(26) VALUE "qwertyuiopasdfghjklzxcvbnm". 05 UPPER-CASE PIC X(26) VALUE "QWERTYUIOPASDFGHJKLZXCVBNM". 01 PROMPT PIC X(09) VALUE "OK (Y/N):". *************************************************************************** * Accept-Status - Used to accept that card is (S)tolen or (C)ancelled from op erator * T-To-Float - Used to convert a Integer to a Float for screen display * Stopper - Used to pause the screen to allow user to view messages * Space-Count - Used to clear the screen * S-Account-Id - Used to accept Account Id for search on file *************************************************************************** 01 MISC-FIELDS. 05 ACCEPT-STATUS PIC X VALUE SPACE. 05 T-TO-FLOAT PIC S9(09)V99. 05 STOPPER PIC X(02) VALUE SPACES. 05 SPACE-COUNT PIC 9(02) VALUE ZEROS. 05 S-ACCOUNT-ID PIC X(10). 01 FLAGZ. 05 GO-FLAG PIC X VALUE "Y". 88 OKAY VALUE "Y". 88 NOT-OKAY VALUE "N". 05 EXIT-FLAG PIC X VALUE "N". 88 THE-END VALUE "Y". 05 WRITE-FLAG PIC X VALUE "N". 88 WRITE-CHANGES VALUE "Y". 05 INVALID-FLAG PIC X VALUE "N". 88 A-MATCH VALUE "N". 88 NO-MATCH VALUE "Y". 01 WROTE-MESSAGE PIC X(57) VALUE "Name(s) and Address have been written to the Client File.". COPY "WORKDATE.LIB". PROCEDURE DIVISION. MAINLINE. PERFORM INITIALIZATION. PERFORM MAIN-PROGRAM UNTIL THE-END. PERFORM TERMINATION. STOP RUN. INITIALIZATION. OPEN I-O CLIENT-FILE. COPY "INITDATE.LIB". DISPLAY SPACES LINE 1 ERASE TO END OF SCREEN. DISPLAY HEADING1 LINE 3 COLUMN 30. DISPLAY HEADING2 LINE 5 COLUMN 31. DISPLAY PRE-INFO1 LINE 7 COLUMN 30. MAIN-PROGRAM. DISPLAY SPACES LINE 22 ERASE TO END OF LINE. MOVE "Y" TO GO-FLAG. PERFORM GET-TIME-DATE. PERFORM CLEAR-THE-SCREEN. PERFORM GET-ACCOUNT-ID. PERFORM CLEAR-20. GET-ACCOUNT-ID. DISPLAY "Enter Account Id:" LINE 12 COLUMN 32. DISPLAY "Type to exit" LINE 22 COLUMN 30. ACCEPT S-ACCOUNT-ID LINE 12 COLUMN 50 PROTECTED DEFAULT SPACES. IF S-ACCOUNT-ID = SPACES THEN MOVE "Y" TO EXIT-FLAG ELSE DISPLAY SPACES LINE 22 ERASE TO END OF SCREEN MOVE S-ACCOUNT-ID TO IDX-ACCOUNT-ID READ CLIENT-FILE INTO CLIENT-READ-IN INVALID KEY PERFORM ACCOUNT-DOES-NOT-EXIST * If Account Is found on file, then Ask Operator if Account is correct, * find out what Status they want to set, and verify of they want to make * the change. If they verify the change, change the status and update the r ecord NOT INVALID KEY DISPLAY SPACES LINE 23 ERASE TO END OF LINE MOVE "N" TO INVALID-FLAG PERFORM DISPLAY-TITLES PERFORM DISPLAY-INFO PERFORM GET-VERIFICATION PERFORM CANCEL-THIS-ACCOUNT IF OKAY THEN MOVE "N" TO GO-FLAG PERFORM SELECT-STATUS-CHANGE UNTIL OKAY PERFORM PROCESS-CHANGES END-IF DISPLAY SPACES LINE 6 ERASE TO END OF SCREEN END-READ END-IF. ACCOUNT-DOES-NOT-EXIST. MOVE "Y" TO INVALID-FLAG. DISPLAY "Account ID Entered not found on file -- Please Re-enter" LINE 23 COLUMN 15. GET-VERIFICATION. DISPLAY "" LINE 20 COLUMN 10 WITH BELL WITH BLINKING REVERSED. SELECT-STATUS-CHANGE. MOVE "Y" TO GO-FLAG. DISPLAY SPACES LINE 20 ERASE TO END OF LINE. DISPLAY "(C)ancel Account or Report it (S)tolen: " LINE 21 COLUMN 20. ACCEPT ACCEPT-STATUS LINE 21 COLUMN 60 PROTECTED. INSPECT ACCEPT-STATUS CONVERTING LOWER-CASE TO UPPER-CASE. EVALUATE ACCEPT-STATUS WHEN "C" MOVE "C" TO ACCOUNT-STATUS WHEN "S" MOVE "S" TO ACCOUNT-STATUS WHEN OTHER MOVE "N" TO GO-FLAG END-EVALUATE. DISPLAY-TITLES. DISPLAY SPACES LINE 6 ERASE TO END OF SCREEN. 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 INFO11 LINE 13 COLUMN 47. DISPLAY INFO12 LINE 15 COLUMN 47. 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. DISPLAY-INFO. DISPLAY PRIMARY-LAST-NAME LINE 7 COLUMN 27. DISPLAY PRIMARY-FIRST-NAME LINE 8 COLUMN 27. DISPLAY PRIMARY-MID-INIT LINE 9 COLUMN 27. DISPLAY SECOND-LAST-NAME LINE 16 COLUMN 27. DISPLAY SECOND-FIRST-NAME LINE 17 COLUMN 27. DISPLAY SECOND-MID-INIT LINE 18 COLUMN 27. MOVE HOME-PHONE TO F-HOME-PHONE. MOVE F-HOME-PHONE TO O-HOME-PHONE. DISPLAY H-AREA-CODE LINE 11 COLUMN 22. DISPLAY H-EXTENSION LINE 11 COLUMN 27. DISPLAY H-NUMBER LINE 11 COLUMN 31. MOVE WORK-PHONE TO F-WORK-PHONE. MOVE F-WORK-PHONE TO O-WORK-PHONE. DISPLAY W-AREA-CODE LINE 12 COLUMN 22. DISPLAY W-EXTENSION LINE 12 COLUMN 27. DISPLAY W-NUMBER LINE 12 COLUMN 31. MOVE DATE-OF-BIRTH TO F-DATE-OF-BIRTH. MOVE F-DATE-OF-BIRTH TO O-DATE-OF-BIRTH. DISPLAY BIRTH-YEAR LINE 14 COLUMN 18. DISPLAY BIRTH-MONTH LINE 14 COLUMN 23. DISPLAY BIRTH-DAY LINE 14 COLUMN 26. MOVE POSTAL-CODE TO O-POSTAL-CODE. DISPLAY POSTAL-ONE LINE 10 COLUMN 63. DISPLAY POSTAL-TWO LINE 10 COLUMN 64. DISPLAY POSTAL-THREE LINE 10 COLUMN 65. DISPLAY POSTAL-FOUR LINE 10 COLUMN 67. DISPLAY POSTAL-FIVE LINE 10 COLUMN 68. DISPLAY POSTAL-SIX LINE 10 COLUMN 69. DISPLAY STREET LINE 7 COLUMN 59. DISPLAY CITY LINE 8 COLUMN 59. DISPLAY PROVINCE LINE 9 COLUMN 59. COPY "EVAL_STATUS.LIB". DISPLAY O-STATUS LINE 17 COLUMN 66. COPY "EVAL_LANG.LIB". DISPLAY O-LANGUAGE-CODE LINE 12 COLUMN 66. DISPLAY S-ACCOUNT-ID LINE 16 COLUMN 60. MOVE CREDIT-LIMIT TO O-CREDIT-LIMIT. DISPLAY O-CREDIT-LIMIT LINE 13 COLUMN 66. MOVE CURRENT-BALANCE TO T-TO-FLOAT. COMPUTE T-TO-FLOAT = ((T-TO-FLOAT / 100) + 0.004). MOVE T-TO-FLOAT TO O-CURRENT-BALANCE. DISPLAY O-CURRENT-BALANCE LINE 18 COLUMN 66 WITH CONVERSION. MOVE MIN-PAY-DUE TO T-TO-FLOAT. COMPUTE T-TO-FLOAT = ((T-TO-FLOAT / 100) + 0.004). MOVE T-TO-FLOAT TO O-MIN-PAY-DUE. DISPLAY O-MIN-PAY-DUE LINE 15 COLUMN 66. PROCESS-CHANGES. DISPLAY SPACES LINE 21 ERASE TO END OF LINE. MOVE "N" TO WRITE-FLAG. DISPLAY "Are You Sure (Y/N)" LINE 21 COLUMN 30. ACCEPT WRITE-FLAG LINE 21 COLUMN 49 PROTECTED DEFAULT "N". INSPECT WRITE-FLAG CONVERTING LOWER-CASE TO UPPER-CASE. IF WRITE-CHANGES THEN PERFORM WRITE-TO-FILE ELSE DISPLAY SPACES LINE 21 ERASE TO END OF LINE END-IF. CANCEL-THIS-ACCOUNT. MOVE "N" TO GO-FLAG. DISPLAY "Cancel This Account (Y/N)" LINE 21 COLUMN 20. ACCEPT WRITE-FLAG LINE 21 COLUMN 46 PROTECTED DEFAULT "N". INSPECT WRITE-FLAG CONVERTING LOWER-CASE TO UPPER-CASE. IF WRITE-CHANGES THEN MOVE "Y" TO GO-FLAG ELSE MOVE "N" TO GO-FLAG END-IF. WRITE-TO-FILE. REWRITE CLIENT-KEYS FROM CLIENT-READ-IN INVALID KEY DISPLAY "NO WRITE!!!" LINE 22 COLUMN 25. 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 64 ERASE TO END OF LINE. COPY "TIMEDATE.LIB". COPY "CLEAR-20.LIB". TERMINATION. DISPLAY SPACES LINE 20 ERASE TO END OF SCREEN. DISPLAY "" LINE 23 COLUMN 30. ACCEPT STOPPER LINE 23 COLUMN 50. CLOSE CLIENT-FILE. >> [?21h IDENTIFICATION DIVISION. PROGRAM-ID. BILLING. AUTHOR. MIKE GALLANT. * This program produces the billing statements for the Seartons Credit * Card System ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. ALPHA. OBJECT-COMPUTER. ALPHA. INPUT-OUTPUT SECTION. FILE-CONTROL. COPY "SELECT_CLIENT.LIB". COPY "SELECT_SALES.LIB". COPY "SELECT_PAYMENT.LIB". COPY "SELECT_RETURN.LIB". COPY "SELECT_SEARTON.LIB". COPY "SELECT_BRANCH.LIB". SELECT PRINTER ASSIGN TO "STATEMENT.RPT". DATA DIVISION. FILE SECTION. COPY "FD_CLIENT.LIB". COPY "FD_SALES.LIB". COPY "FD_PAYMENT.LIB". COPY "FD_RETURN.LIB". COPY "FD_SEARTON.LIB". COPY "FD_BRANCH.LIB". * Used for writing the billing statements to file FD PRINTER RECORD CONTAINS 80 CHARACTERS LABEL RECORDS OMITTED. 01 PRINT-LINE PIC X(80). WORKING-STORAGE SECTION. COPY "CLIENTREADIN.LIB". COPY "SALESREADIN.LIB". COPY "PAYMENTREADIN.LIB". COPY "RETURNREADIN.LIB". COPY "SEARTONREADIN.LIB". COPY "BRANCHREADIN.LIB". * Main Headings for Screen 01 HEADING1 PIC X(27) VALUE "SEARTONS CREDIT CARD SYSTEM". 01 HEADING2 PIC X(18) VALUE "BILLING STATEMENTS". 01 HEADING3 PIC X(19) VALUE "1) Billing Day 14th". 01 HEADING4 PIC X(19) VALUE "2) Billing Day 28th". 01 HEADING5 PIC X(07) VALUE "0) Exit". 01 HEADING6 PIC X(23) VALUE "Please enter selection:". 01 SELECTION-PROMPT PIC X(18) VALUE "Are you sure(Y/N)?". 01 PROCESSING-PROMPT PIC X(32) VALUE "Processing Billing Statements...". 01 RETURN-PROMPT PIC X(32) VALUE "Please press return to continue!". * For accepting and validating operator selection on screen 01 BILL-DATE PIC 9. 88 BILL-DATE-VALID VALUES 0 1 2. * Used to search for matching billing dates in Client file. 01 OUT-BILL-DATE PIC 9(02) VALUE ZEROES. 01 BIN-BILL-DATE PIC S9(09) COMP. COPY "WORKDATE.LIB". COPY "BILLING-STATEMENT.LIB". * Formatted fields used for writing to the Billing Statement 01 OUTPUT-FIELDS. 05 O-ACCOUNT-ID. 10 O-ACCT-PART1 PIC X(04). 10 FILLER PIC X VALUE "-". 10 O-ACCT-PART2 PIC X(06). 05 O-LANGUAGE-CODE PIC X(07). 05 O-STATUS PIC X(09). 05 O-CURRENT-BALANCE PIC $$$,$$$,$$$.99. 05 O-PAYMENT-DUE PIC $$$,$$$,$$$.99. 05 O-CREDIT-LIMIT PIC $$$,$$$,$$$.99. 05 O-CREDIT-AVAILABLE PIC $$$,$$$,$$$.99. 05 O-DATE-OF-BIRTH. 10 O-YEAR PIC 9(04). 10 FILLER PIC X VALUE "/". 10 O-MONTH PIC 9(02). 10 FILLER PIC X VALUE "/". 10 O-DAY PIC 9(02). 05 O-PHONE-NUMBER. 10 FILLER PIC X VALUE "(". 10 O-PHONE-PART1 PIC 9(03). 10 FILLER PIC X VALUE ")". 10 O-PHONE-PART2 PIC 9(03). 10 FILLER PIC X VALUE "-". 10 O-PHONE-PART3 PIC 9(04). 05 O-STATEMENT-DAY PIC 9(02). 01 SEPERATOR-LINE PIC X(80) VALUE "_____________________________________________________________________ ________". ***************************************************************************** * Search-Account-Id - Account Id entered by operator to search by on file * Search-Last-Name - Last Name String Entered by operator to search by one fi le * E-Search-Last-Name - Used to Accept Last Name String to Search on * T-Date-Of-Birth - Used to Store Birth Date of Card Holder before displaying it * E-Found-Flag - Used to accept whether Operator has found correct account on Last Name search * T-Branch-Id - Used to Store Branch ID of Transaction before displaying it o n the screen * Primary-Name - Compress Combo of Primary Card Holders First, Middle and Las t names * Line-Count - To keep track of screen position * T-To-Float - This variable is used to convert a integer to a float data typ e for screen display * All-Nines - To fill a search field with the highest possible number to forc e an End-Of-File flag when no more matches * Line-Clear - To clear a line on the screen * T-Home-Phone - Used to store Phone Number before displaying it on the scree n * Begin-Date - The Date to begin showing transactions from * Begin-Month - The month to begin showing transactions from * Begin-Day - The Day to begin showing transactions from * Prompt - Used to accept information from user * The-Due-Day - Stores the Day that the user must pay their statement by. * The-Due-Month - Stores the Month that the user must pay their statement by * The-Due-Year - Stores the Month that the user must pay their statement by * Spec-Leap-Year - Used to calculate the Leap Year * O-Location - Used to display Location that Transaction of Billing Statement was made at * The-Interest-Rate - Contains the Current Rate per Month * Yearly-Interest-Rate - Contains the Current Rate per Year * Statements Produced - Number of Billing Statements created ***************************************************************************** 01 MISC-FIELDS. 05 SEARCH-ACCOUNT-ID PIC X(10). 05 SEARCH-LAST-NAME PIC X(12) VALUE SPACES. 05 E-SEARCH-LAST-NAME PIC X(12) VALUE SPACES. 05 T-DATE-OF-BIRTH PIC 9(08). 05 E-FOUND-FLAG PIC X. 05 T-BRANCH-ID PIC X(04). 05 PRIMARY-NAME PIC X(30). 05 LINE-COUNT PIC 9(02) VALUE ZEROES. 05 T-TO-FLOAT PIC S9(09)V99. 05 ALL-NINES PIC X(24) VALUE "999999999999999999999999 ". 05 LINE-CLEAR PIC 9(02) VALUE ZEROES. 05 T-HOME-PHONE PIC 9(10). 05 BEGIN-DATE PIC X(08). 05 BEGIN-MONTH PIC 9(02). 05 BEGIN-DAY PIC 9(02). 05 PROMPT PIC X. 05 THE-DUE-DAY PIC 9(02). 05 THE-DUE-MONTH PIC 9(02). 05 THE-DUE-YEAR PIC 9(04). 05 SPEC-LEAP-YEAR PIC 9(02) VALUE ZEROS. 05 O-LOCATION PIC X(20). 05 THE-INTEREST-RATE PIC 9(08). 05 YEARLY-INTEREST-RATE PIC 9(08). 05 STATEMENTS-PRODUCED PIC 9(04) VALUE ZEROS. 01 FLAGZ. * All-purpose flag used as a DO....WHILE 05 OK-FLAG PIC X VALUE "N". 88 OKAY VALUE "Y". 88 NOT-OKAY VALUE "N". * Used to indicate that there are no more records matching current account in Pa yment file 05 PAYMENT-FLAG PIC X VALUE "N". 88 PAYMENT-DONE VALUE "Y". 88 PAYMENT-NOT-DONE VALUE "N". * Used to indicate that there are no more records matching current account in Sa les file 05 SALES-FLAG PIC X VALUE "N". 88 SALES-DONE VALUE "Y". 88 SALES-NOT-DONE VALUE "N". * Used to indicate that there are no more records matching current account in Pa yment file 05 RETURN-FLAG PIC X VALUE "N". 88 RETURN-DONE VALUE "Y". 88 RETURN-NOT-DONE VALUE "N". * Used for calculating totals on the Billing Statement 01 TOTALS. 05 PREV-MIN-PAY-DUE PIC S9(11). 05 PREV-TOTAL-PAYMENTS PIC S9(11). 05 PREV-TOTAL-PURCHASES PIC S9(11). 05 PAST-DUE-AMT PIC S9(11). 05 MINIMUM-PAYMENT PIC S9(11). 05 CURRENT-PAYMENT PIC S9(11). 05 NEW-CURR-BALANCE PIC S9(11). 05 THE-INTEREST-OWED PIC S9(11). 05 OLD-BALANCE PIC S9(11). 05 AMT-OVERLIMIT PIC S9(11). 05 MIN-PAYMENT-ALLOWED PIC S9(11). 05 THE-ACTUAL-LIMIT PIC S9(11). 05 THE-CREDIT-LIMIT PIC 9(11). 05 ALL-ZEROS PIC 9(11) VALUE ZEROES. * These are floating point values for use on Billing Statement to show amounts w ith dollars and cents 01 DISPLAY-TOTALS. 05 STOTAL-PAYMENTS PIC S9(09)V99. 05 STOTAL-PURCHASES PIC S9(09)V99. 05 STOTAL-RETURNS PIC S9(09)V99. 05 SCURRENT-PAYMENT PIC S9(09)V99. 05 SNEW-CURR-BALANCE PIC S9(09)V99. 05 SPAST-DUE-AMT PIC S9(09)V99. 05 SINTEREST-OWED PIC S9(09)V99. 05 SMINIMUM-PAYMENT PIC S9(09)V99. 05 SPREV-BALANCE PIC S9(09)V99. 05 SACTUAL-LIMIT PIC S9(09)V99. 05 SINTEREST-RATE PIC S9(09)V99. 05 SPAST-DUE PIC S9(09)V99. 05 SOUT-OVERLIMIT PIC S9(09)V99. * Used to search files for transactions matching current Account being processed 01 SEARCH-KEYZ. 05 SALES-SEARCH-KEY PIC X(24). 05 PAYMENT-SEARCH-KEY PIC X(24). 05 RETURN-SEARCH-KEY PIC X(24). * Used to write detail lines to Billing Statement 01 BILLING-OUTPUT. 05 FILLER PIC X(05). 05 O-TRANS-DATE. 10 O-TRANS-YEAR PIC X(04). 10 FILLER PIC X VALUE "/". 10 O-TRANS-MONTH PIC X(02). 10 FILLER PIC X VALUE "/". 10 O-TRANS-DAY PIC X(02). 10 FILLER PIC X(02) VALUE SPACES. 10 O-TRANS-HOUR PIC X(02). 10 FILLER PIC X VALUE ":". 10 O-TRANS-MINUTE PIC X(02). 10 FILLER PIC X(11) VALUE SPACES. 05 O-TRANS-DESC PIC X(25). 05 FILLER PIC X(07) VALUE SPACES. 05 O-TRANS-AMT PIC $$$,$$$,$$9.99-. PROCEDURE DIVISION. MAINLINE. PERFORM INITIALIZATION. PERFORM MAIN-PROGRAM UNTIL NOT-OKAY. PERFORM TERMINATION. STOP RUN. INITIALIZATION. MOVE ZEROES TO STATEMENTS-PRODUCED. MOVE "N" TO PAYMENT-FLAG, SALES-FLAG, RETURN-FLAG. COPY "INITDATE.LIB". MOVE "N" TO OK-FLAG. DISPLAY SPACES LINE 1 ERASE TO END OF SCREEN. COPY "INITDATE.LIB". PERFORM GET-TIME-DATE. OPEN INPUT PAYMENT-FILE SALES-FILE RETURN-FILE. OPEN OUTPUT PRINTER. OPEN I-O CLIENT-FILE. DISPLAY HEADING1 LINE 3 COLUMN 28. DISPLAY HEADING2 LINE 5 COLUMN 32. DISPLAY HEADING3 LINE 7 COLUMN 28. DISPLAY HEADING4 LINE 9 COLUMN 28. DISPLAY HEADING5 LINE 11 COLUMN 28. DISPLAY HEADING6 LINE 13 COLUMN 28. PERFORM GET-BILL-DATE UNTIL BILL-DATE = 9. * Get user to enter what billing date they want to process GET-BILL-DATE. MOVE "N" TO OK-FLAG ACCEPT BILL-DATE LINE 13 COLUMN 52 PROTECTED WITH CONVERSION. EVALUATE BILL-DATE WHEN 1 MOVE 14 TO OUT-BILL-DATE WHEN 2 MOVE 28 TO OUT-BILL-DATE WHEN OTHER MOVE ZEROES TO OUT-BILL-DATE MOVE 9 TO BILL-DATE END-EVALUATE. IF OUT-BILL-DATE NOT EQUAL ZEROES DISPLAY SELECTION-PROMPT LINE 15 COLUMN 26 ACCEPT PROMPT LINE 15 COLUMN 46 PROTECTED MOVE FUNCTION UPPER-CASE(PROMPT) TO PROMPT EVALUATE PROMPT WHEN "Y" MOVE "Y" TO OK-FLAG MOVE 9 TO BILL-DATE WHEN "E" MOVE 9 TO BILL-DATE WHEN OTHER MOVE ZEROES TO BILL-DATE END-EVALUATE ELSE MOVE 9 TO BILL-DATE END-IF. MAIN-PROGRAM. DISPLAY "Processing......Please Wait" LINE 15 COLUMN 26. PERFORM GET-INTEREST-RATE. * To convert Billing Date entered by user to Binary MOVE OUT-BILL-DATE TO STATEMENT-DAY. MOVE OUT-BILL-DATE TO BIN-BILL-DATE. MOVE BIN-BILL-DATE TO IDX-STATEMENT-DAY. * Search Client File for first record matching billing date entered READ CLIENT-FILE INTO CLIENT-READ-IN KEY IS IDX-STATEMENT-DAY * If no Accounts for billing date entered, Display message INVALID KEY DISPLAY "Report Processing Cancelled" LINE 23 COLUMN 27 ACCEPT PROMPT LINE 1 COLUMN 1 PROTECTED * If match found, see if they have any transactions NOT INVALID KEY PERFORM CHECK-FOR-TRANSACTIONS END-READ. PERFORM READ-NEXT-RECORD UNTIL NOT-OKAY. DISPLAY "Done!.....Number of Statements Produced: " LINE 17 COLUMN 18. DISPLAY STATEMENTS-PRODUCED LINE 17 COLUMN 59. READ-NEXT-RECORD. READ CLIENT-FILE NEXT INTO CLIENT-READ-IN AT END MOVE "N" TO OK-FLAG. MOVE STATEMENT-DAY TO O-STATEMENT-DAY. IF O-STATEMENT-DAY NOT EQUAL OUT-BILL-DATE THEN MOVE "N" TO OK-FLAG. IF OKAY THEN PERFORM CHECK-FOR-TRANSACTIONS. GET-INTEREST-RATE. OPEN INPUT SEARTONS-WORK. READ SEARTONS-WORK INTO SEARTON-READ-IN AT END CONTINUE. MOVE INT-RATE TO THE-INTEREST-RATE. MOVE THE-INTEREST-RATE TO YEARLY-INTEREST-RATE. COMPUTE THE-INTEREST-RATE = (THE-INTEREST-RATE / 12). CLOSE SEARTONS-WORK. CHECK-FOR-TRANSACTIONS. MOVE SYS-DATE TO BEGIN-DATE. MOVE STATEMENT-DAY TO O-STATEMENT-DAY. MOVE O-STATEMENT-DAY TO BEGIN-DAY. MOVE BEGIN-DATE(5:2) TO BEGIN-MONTH. IF SYS-DATE(7:2) < BEGIN-DAY THEN SUBTRACT 1 FROM BEGIN-MONTH. IF BEGIN-MONTH = ZEROES THEN MOVE 12 TO BEGIN-MONTH. MOVE BEGIN-MONTH TO BEGIN-DATE(5:2). MOVE BEGIN-DAY TO BEGIN-DATE(7:2). MOVE ACCOUNT-ID TO IDX-SALES, IDX-PAYMENT, IDX-RETURN. MOVE BEGIN-DATE TO IDX-SALES(11:8), IDX-PAYMENT(11:8), IDX-RETURN(11:8). MOVE ZEROES TO IDX-SALES(19:6), IDX-PAYMENT(19:6), IDX-RETURN(19:6). * Calculate interest, Minimum Payment Due, OverDue Payment, etc. PERFORM DO-CALCULATIONS. * If no transactions for current billing cycle, skip printing of statement IF PREV-TOTAL-PURCHASES = ZEROES AND PREV-TOTAL-PAYMENTS = ZEROES THEN CONTINUE ELSE ADD 1 TO STATEMENTS-PRODUCED * Move Calculated fields to Print-Line fields PERFORM MOVE-CALCULATIONS-TO-STATEMENT PERFORM PRINT-TOP-OF-FORM MOVE "N" TO PAYMENT-FLAG, SALES-FLAG, RETURN-FLAG PERFORM SEARCH-SALES-FILE PERFORM SEARCH-PAYMENT-FILE PERFORM SEARCH-RETURN-FILE * Write all transactions for account since the last statement date PERFORM PRINT-TRANSACTIONS UNTIL PAYMENT-DONE AND SALES-DONE AND RETURN- DONE PERFORM PRINT-BOTTOM-OF-FORM PERFORM UPDATE-CLIENT-FILE END-IF. DO-CALCULATIONS. MOVE CREDIT-LIMIT TO THE-CREDIT-LIMIT. MOVE ACTUAL-CRD-LIMIT TO THE-ACTUAL-LIMIT. MOVE MIN-PAY-DUE TO PREV-MIN-PAY-DUE. MOVE TOTAL-PAYMENTS TO PREV-TOTAL-PAYMENTS. MOVE TOTAL-PURCHASES TO PREV-TOTAL-PURCHASES. MOVE PREV-BALANCE TO OLD-BALANCE. COMPUTE PAST-DUE-AMT = (PREV-MIN-PAY-DUE - PREV-TOTAL-PAYMENTS). IF PAST-DUE-AMT < 1 THEN MOVE ZEROES TO PAST-DUE-AMT. COMPUTE THE-INTEREST-OWED = ((OLD-BALANCE + PREV-TOTAL-PURCHASES - PREV-TOTA L-PAYMENTS) * (THE-INTEREST-RATE / 10000)). COMPUTE NEW-CURR-BALANCE = (THE-INTEREST-OWED + OLD-BALANCE + PREV-TOTAL-PUR CHASES - PREV-TOTAL-PAYMENTS). COMPUTE AMT-OVERLIMIT = NEW-CURR-BALANCE - (THE-CREDIT-LIMIT * 100). IF AMT-OVERLIMIT < 1 THEN MOVE ZEROES TO AMT-OVERLIMIT. MOVE 1000 TO MIN-PAYMENT-ALLOWED. COMPUTE CURRENT-PAYMENT = (NEW-CURR-BALANCE * 0.1). IF CURRENT-PAYMENT < MIN-PAYMENT-ALLOWED AND NEW-CURR-BALANCE > 1000 THEN MOVE MIN-PAYMENT-ALLOWED TO CURRENT-PAYMENT. IF NEW-CURR-BALANCE < 1000 THEN MOVE NEW-CURR-BALANCE TO CURRENT-PAYMENT. IF NEW-CURR-BALANCE < 1 THEN MOVE ZEROES TO CURRENT-PAYMENT. COMPUTE MINIMUM-PAYMENT = (CURRENT-PAYMENT + AMT-OVERLIMIT + PAST-DUE-AMT). SUBTRACT THE-INTEREST-OWED FROM THE-ACTUAL-LIMIT. IF THE-ACTUAL-LIMIT < 0 THEN MOVE ZEROES TO THE-ACTUAL-LIMIT. PERFORM SETUP-OUTPUT-FIELDS. * Converts fields to floating point for writing to Billing Statement SETUP-OUTPUT-FIELDS. IF PREV-TOTAL-PURCHASES < 0 THEN COMPUTE STOTAL-PURCHASES = ((PREV-TOTAL-PURCHASES / 100) - 0.004) ELSE COMPUTE STOTAL-PURCHASES = ((PREV-TOTAL-PURCHASES / 100) + 0.004) END-IF. IF PREV-TOTAL-PAYMENTS < 0 THEN COMPUTE STOTAL-PAYMENTS = ((PREV-TOTAL-PAYMENTS / 100) - 0.004) ELSE COMPUTE STOTAL-PAYMENTS = ((PREV-TOTAL-PAYMENTS / 100) + 0.004) END-IF. IF CURRENT-PAYMENT < 0 THEN COMPUTE SCURRENT-PAYMENT = ((CURRENT-PAYMENT / 100) - 0.004) ELSE COMPUTE SCURRENT-PAYMENT = ((CURRENT-PAYMENT / 100) + 0.004) END-IF. IF NEW-CURR-BALANCE < 0 THEN COMPUTE SNEW-CURR-BALANCE = ((NEW-CURR-BALANCE /100) - 0.004) ELSE COMPUTE SNEW-CURR-BALANCE = ((NEW-CURR-BALANCE /100) + 0.004) END-IF. COMPUTE SPAST-DUE-AMT = ((PAST-DUE-AMT / 100) + 0.004) IF THE-INTEREST-OWED < 0 THEN COMPUTE SINTEREST-OWED = ((THE-INTEREST-OWED / 100) - 0.004) ELSE COMPUTE SINTEREST-OWED = ((THE-INTEREST-OWED / 100) + 0.004) END-IF. IF MINIMUM-PAYMENT < 0 THEN COMPUTE SMINIMUM-PAYMENT = ((MINIMUM-PAYMENT / 100) - 0.004) ELSE COMPUTE SMINIMUM-PAYMENT = ((MINIMUM-PAYMENT / 100) + 0.004) END-IF. IF OLD-BALANCE < 0 THEN COMPUTE SPREV-BALANCE = ((OLD-BALANCE / 100) - 0.004) ELSE COMPUTE SPREV-BALANCE = ((OLD-BALANCE / 100) + 0.004) END-IF. COMPUTE SACTUAL-LIMIT = ((THE-ACTUAL-LIMIT / 100) + 0.004). COMPUTE SINTEREST-RATE = ((YEARLY-INTEREST-RATE / 100) + 0.004). COMPUTE SOUT-OVERLIMIT = ((AMT-OVERLIMIT / 100) + 0.004). MOVE-CALCULATIONS-TO-STATEMENT. MOVE SOUT-OVERLIMIT TO OUT-OVERLIMIT. MOVE SPAST-DUE-AMT TO OUT-PAST-DUE. MOVE SCURRENT-PAYMENT TO OUT-CURRENT-DUE. MOVE SMINIMUM-PAYMENT TO OUT-MIN-PAYMENT-DUE, O-MIN-PAY-DUE. PERFORM GET-DUE-DATE. MOVE OUT-BILL-DATE TO OUT-STATEMENT-DAY, BILL-DAY. MOVE SYS-MONTH TO OUT-STATEMENT-MONTH, BILL-MONTH. MOVE SYS-YEAR TO OUT-STATEMENT-YEAR, BILL-YEAR. MOVE ACCOUNT-ID(1:4) TO ACCT-1, OUT-ACCT1. MOVE ACCOUNT-ID(5:6) TO ACCT-2, OUT-ACCT2. MOVE "800" TO OUT-AREA-CODE. MOVE "SEA" TO OUT-EXCHANGE. MOVE "RTON" TO OUT-NUMBER. MOVE STOTAL-PURCHASES TO OUT-CREDIT-CHARGES. MOVE STOTAL-PAYMENTS TO OUT-TOTAL-PAYMENTS. MOVE SINTEREST-OWED TO OUT-TOTAL-INTEREST. MOVE SNEW-CURR-BALANCE TO OUT-NEW-BALANCE. MOVE SINTEREST-RATE TO OUT-INTEREST-RATE. MOVE THE-CREDIT-LIMIT TO OUT-CREDIT-LIMIT. MOVE SACTUAL-LIMIT TO OUT-CREDIT-AVAILABLE. MOVE SPREV-BALANCE TO OUT-PREV-BALANCE. MOVE SPACES TO CARD-HOLDERS. MOVE SPACES TO CARD-ADDRESS. IF SECOND-LAST-NAME NOT EQUAL SPACES THEN STRING PRIMARY-FIRST-NAME DELIMITED BY " " " " DELIMITED BY SIZE PRIMARY-LAST-NAME DELIMITED BY SPACE " & " DELIMITED BY SIZE SECOND-FIRST-NAME DELIMITED BY SPACE " " DELIMITED BY SIZE SECOND-LAST-NAME DELIMITED BY SPACE INTO CARD-HOLDERS ELSE STRING PRIMARY-FIRST-NAME DELIMITED BY " " " " DELIMITED BY SIZE PRIMARY-LAST-NAME DELIMITED BY SPACE INTO CARD-HOLDERS END-IF. MOVE STREET TO CARD-STREET. STRING CITY DELIMITED BY ' ' " " DELIMITED BY SIZE PROVINCE DELIMITED BY SIZE " " DELIMITED BY SIZE POSTAL-CODE DELIMITED BY SIZE INTO CARD-ADDRESS. UPDATE-CLIENT-FILE. MOVE MINIMUM-PAYMENT TO MIN-PAY-DUE. MOVE ALL-ZEROS TO TOTAL-PAYMENTS. MOVE ALL-ZEROS TO TOTAL-PURCHASES. MOVE NEW-CURR-BALANCE TO PREV-BALANCE. MOVE THE-INTEREST-OWED TO INTEREST-OWED. REWRITE CLIENT-KEYS FROM CLIENT-READ-IN INVALID KEY DISPLAY "UPDATE NOT MADE -- Processing Cancelled". PRINT-TRANSACTIONS. MOVE 19 TO LINE-COUNT. IF SALES-SEARCH-KEY < PAYMENT-SEARCH-KEY AND SALES-SEARCH-KEY < RETURN-SEARC H-KEY AND SALES-NOT-DONE THEN PERFORM MOVE-SALES-TO-OUTPUT PERFORM SEARCH-SALES-FILE ELSE IF PAYMENT-SEARCH-KEY < RETURN-SEARCH-KEY AND PAYMENT-NOT-DONE PERFORM MOVE-PAYMENT-TO-OUTPUT PERFORM SEARCH-PAYMENT-FILE ELSE IF RETURN-NOT-DONE PERFORM MOVE-RETURN-TO-OUTPUT PERFORM SEARCH-RETURN-FILE END-IF END-IF END-IF. COPY "SEARCH-TRANS-FILES.LIB". MOVE-SALES-TO-OUTPUT. PERFORM CHECK-PAGE-BREAK. MOVE SALES-SEARCH-KEY(11:4) TO O-TRANS-YEAR. MOVE SALES-SEARCH-KEY(15:2) TO O-TRANS-MONTH. MOVE SALES-SEARCH-KEY(17:2) TO O-TRANS-DAY. MOVE SALES-SEARCH-KEY(19:2) TO O-TRANS-HOUR. MOVE SALES-SEARCH-KEY(21:2) TO O-TRANS-MINUTE. MOVE S-BRANCH-ID TO T-BRANCH-ID. PERFORM SEARCH-FOR-BRANCH. STRING "Sale " DELIMITED BY SIZE, O-LOCATION DELIMITED BY SIZE INTO O-TRANS-DESC. MOVE PURCHASE-AMT TO T-TO-FLOAT. COMPUTE T-TO-FLOAT = (T-TO-FLOAT / 100). MOVE T-TO-FLOAT TO O-TRANS-AMT. WRITE PRINT-LINE FROM BILLING-OUTPUT AFTER ADVANCING 1 LINE. MOVE-PAYMENT-TO-OUTPUT. PERFORM CHECK-PAGE-BREAK. MOVE PAYMENT-SEARCH-KEY(11:4) TO O-TRANS-YEAR. MOVE PAYMENT-SEARCH-KEY(15:2) TO O-TRANS-MONTH. MOVE PAYMENT-SEARCH-KEY(17:2) TO O-TRANS-DAY. MOVE PAYMENT-SEARCH-KEY(19:2) TO O-TRANS-HOUR. MOVE PAYMENT-SEARCH-KEY(21:2) TO O-TRANS-MINUTE. MOVE P-BRANCH-ID TO T-BRANCH-ID. PERFORM SEARCH-FOR-BRANCH. STRING "Payment " DELIMITED BY SIZE, O-LOCATION DELIMITED BY SIZE INTO O-TRANS-DESC. MOVE PAYMENT-AMT TO T-TO-FLOAT. COMPUTE T-TO-FLOAT = (T-TO-FLOAT / 100). COMPUTE T-TO-FLOAT = T-TO-FLOAT - (T-TO-FLOAT * 2). MOVE T-TO-FLOAT TO O-TRANS-AMT. WRITE PRINT-LINE FROM BILLING-OUTPUT AFTER ADVANCING 1 LINE. MOVE-RETURN-TO-OUTPUT. PERFORM CHECK-PAGE-BREAK. MOVE RETURN-SEARCH-KEY(11:4) TO O-TRANS-YEAR. MOVE RETURN-SEARCH-KEY(15:2) TO O-TRANS-MONTH. MOVE RETURN-SEARCH-KEY(17:2) TO O-TRANS-DAY. MOVE RETURN-SEARCH-KEY(19:2) TO O-TRANS-HOUR. MOVE RETURN-SEARCH-KEY(21:2) TO O-TRANS-MINUTE. MOVE R-BRANCH-ID TO T-BRANCH-ID. PERFORM SEARCH-FOR-BRANCH. STRING "Return " DELIMITED BY SIZE, O-LOCATION DELIMITED BY SIZE INTO O-TRANS-DESC. MOVE RETURN-AMT TO T-TO-FLOAT. COMPUTE T-TO-FLOAT = ((T-TO-FLOAT / 100) + 0.004). COMPUTE T-TO-FLOAT = T-TO-FLOAT - (T-TO-FLOAT * 2). MOVE T-TO-FLOAT TO O-TRANS-AMT. WRITE PRINT-LINE FROM BILLING-OUTPUT AFTER ADVANCING 1 LINE. COPY "SEARCHBRANCH.LIB". CHECK-PAGE-BREAK. ADD 1 TO LINE-COUNT. IF LINE-COUNT > 30 THEN PERFORM PRINT-BOTTOM-OF-FORM PERFORM PRINT-TOP-OF-FORM MOVE 19 TO LINE-COUNT END-IF. PRINT-TOP-OF-FORM. WRITE PRINT-LINE FROM BILLING-LINE1 AFTER ADVANCING PAGE. WRITE PRINT-LINE FROM BILLING-LINE2 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM BILLING-LINE3 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM BILLING-LINE4 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM BILLING-LINE5 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM BILLING-LINE6 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM BILLING-LINE7 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM BILLING-LINE8 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM BILLING-LINE9 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM BILLING-LINE10 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM BILLING-LINE11 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM BILLING-LINE12 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM BILLING-LINE13 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM BILLING-LINE14 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM BILLING-LINE15 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM BILLING-LINE16 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM BILLING-LINE17 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM SEPERATOR-LINE AFTER ADVANCING 2 LINES. WRITE PRINT-LINE FROM BILLING-LINE18 AFTER ADVANCING 2 LINES. WRITE PRINT-LINE FROM BILLING-LINE19 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM BILLING-LINE20 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM BILLING-LINE21 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM BILLING-LINE22 AFTER ADVANCING 2 LINES. WRITE PRINT-LINE FROM BILLING-LINE23 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM BILLING-LINE24 AFTER ADVANCING 1 LINE. PRINT-BOTTOM-OF-FORM. WRITE PRINT-LINE FROM BILLING-LINE25 AFTER ADVANCING 2 LINES. WRITE PRINT-LINE FROM BILLING-LINE26 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM BILLING-LINE27 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM BILLING-LINE28 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM BILLING-LINE29 AFTER ADVANCING 2 LINES. WRITE PRINT-LINE FROM BILLING-LINE30 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM BILLING-LINE31 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM BILLING-LINE32 AFTER ADVANCING 1 LINE. COPY "TIMEDATE.LIB". GET-DUE-DATE. MOVE SYS-YEAR TO THE-DUE-YEAR. MOVE SYS-MONTH TO THE-DUE-MONTH. MOVE OUT-BILL-DATE TO THE-DUE-DAY. EVALUATE THE-DUE-MONTH WHEN 01 PERFORM SET-30-DAYS WHEN 02 PERFORM SET-Q-DAYS WHEN 03 PERFORM SET-31-DAYS WHEN 04 PERFORM SET-30-DAYS WHEN 05 PERFORM SET-31-DAYS WHEN 06 PERFORM SET-30-DAYS WHEN 07 PERFORM SET-31-DAYS WHEN 08 PERFORM SET-31-DAYS WHEN 09 PERFORM SET-30-DAYS WHEN 10 PERFORM SET-31-DAYS WHEN 11 PERFORM SET-30-DAYS WHEN 12 PERFORM SET-31-DAYS END-EVALUATE. MOVE THE-DUE-YEAR TO YEAR-DUE, OUT-PAYMENT-YEAR. MOVE THE-DUE-MONTH TO MONTH-DUE, OUT-PAYMENT-MONTH. MOVE THE-DUE-DAY TO DAY-DUE, OUT-PAYMENT-DAY. SET-Q-DAYS. COMPUTE SPEC-LEAP-YEAR = (FUNCTION MOD (THE-DUE-YEAR - 1600, 4)). IF SPEC-LEAP-YEAR NOT EQUAL ZERO THEN PERFORM CHECK-28-DAYS ELSE PERFORM CHECK-29-DAYS END-IF. CHECK-28-DAYS. COMPUTE THE-DUE-DAY = THE-DUE-DAY + 15. IF THE-DUE-DAY > 28 THEN ADD 1 TO THE-DUE-MONTH IF THE-DUE-MONTH > 12 THEN ADD 1 TO THE-DUE-YEAR MOVE 1 TO THE-DUE-MONTH END-IF END-IF. CHECK-29-DAYS. COMPUTE THE-DUE-DAY = THE-DUE-DAY + 15. IF THE-DUE-DAY > 29 THEN ADD 1 TO THE-DUE-MONTH IF THE-DUE-MONTH > 12 THEN ADD 1 TO THE-DUE-YEAR MOVE 1 TO THE-DUE-MONTH END-IF END-IF. SET-31-DAYS. COMPUTE THE-DUE-DAY = THE-DUE-DAY + 15. IF THE-DUE-DAY > 31 THEN ADD 1 TO THE-DUE-MONTH IF THE-DUE-MONTH > 12 THEN ADD 1 TO THE-DUE-YEAR MOVE 1 TO THE-DUE-MONTH END-IF END-IF. SET-30-DAYS. COMPUTE THE-DUE-DAY = THE-DUE-DAY + 15. IF THE-DUE-DAY > 30 THEN ADD 1 TO THE-DUE-MONTH IF THE-DUE-MONTH > 12 THEN ADD 1 TO THE-DUE-YEAR MOVE 1 TO THE-DUE-MONTH END-IF END-IF. TERMINATION. DISPLAY SPACES LINE 23 ERASE TO END OF LINE. DISPLAY "" LINE 23 COLUMN 30. ACCEPT OK-FLAG LINE 23 COLUMN 50. CLOSE CLIENT-FILE PAYMENT-FILE SALES-FILE RETURN-FILE PRINTER. >> [?21h IDENTIFICATION DIVISION. PROGRAM-ID. AR. AUTHOR. MIKE GALLANT. * This program will print a Accounts Receivable register up to the current date. * It will consist of the Account Number, Previous Balance, Total Payments, * Sales, Credit Charges and calculate Current Balance due. * It will be sorted by Account ID and provide totals for each field at the end. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. ALPHA. OBJECT-COMPUTER. ALPHA. DATA DIVISION. WORKING-STORAGE SECTION. 01 HEADING1 PIC X(27) VALUE "SEARTONS CHARGE CARD SYSTEM". 01 HEADING2 PIC X(28) VALUE "ACCOUNTS RECEIVABLE REGISTER". 01 HEADING3. 05 FILLER PIC X(07) VALUE "AS OF: ". 05 REPORT-YEAR PIC X(04). 05 FILLER PIC X VALUE "-". 05 REPORT-MONTH PIC X(02). 05 FILLER PIC X VALUE "-". 05 REPORT-DAY PIC X(02). 01 HEADING4 PIC X(28) VALUE "Are You Sure (Yes/No/Exit) :". 01 PRINTING-MESSAGE PIC X(28) VALUE "Printing . . . . Please Wait". 01 DONE-MESSAGE PIC X(18) VALUE "Done! Hit Return:". 01 GO-FLAG PIC X VALUE "N". 88 OKAY VALUE "Y". 88 NOT-OKAY VALUE "N". 01 CHANGE-FLAG PIC X VALUE "N". 88 MAKE-CHANGES VALUE "Y". 88 NO-CHANGES VALUE "N". 01 SPEC-LEAP-YEAR PIC 9(02) VALUE ZEROES. COPY "WORKDATE.LIB". LINKAGE SECTION. 01 PRINT-DATE PIC X(10). 01 PROMPT PIC X. PROCEDURE DIVISION USING PRINT-DATE, PROMPT. MAINLINE. MOVE "Y" TO CHANGE-FLAG. PERFORM INITIALIZATION UNTIL NO-CHANGES. EXIT PROGRAM. INITIALIZATION. DISPLAY SPACES LINE 1 ERASE TO END OF SCREEN. MOVE "N" TO GO-FLAG. COPY "INITDATE.LIB". PERFORM GET-TIME-DATE. MOVE THE-YEAR TO REPORT-YEAR. MOVE THE-MONTH TO REPORT-MONTH. MOVE THE-DAY TO REPORT-DAY. DISPLAY HEADING1 LINE 3 COLUMN 26. DISPLAY HEADING2 LINE 5 COLUMN 26. DISPLAY HEADING3 LINE 6 COLUMN 31. MOVE REPORT-YEAR TO PRINT-DATE. MOVE REPORT-MONTH TO PRINT-DATE(5:2). MOVE REPORT-DAY TO PRINT-DATE(7:2). DISPLAY HEADING4 LINE 8 COLUMN 26. ACCEPT PROMPT LINE 8 COLUMN 56 PROTECTED. MOVE FUNCTION UPPER-CASE(PROMPT) TO PROMPT. IF PROMPT = "Y" OR PROMPT = "E" THEN MOVE "N" TO CHANGE-FLAG ELSE MOVE "Y" TO CHANGE-FLAG END-IF. IF PROMPT = "Y" THEN DISPLAY PRINTING-MESSAGE LINE 13 COLUMN 25. COPY "TIMEDATE.LIB". >> [?21h IDENTIFICATION DIVISION. PROGRAM-ID. CHANCRED. AUTHOR. MIKE GALLANT. * This program is very similar to APPLENTRY.COB. That is the program * that allows you to enter new credit card applicants. Please Refer to docum entation * in that program as putting it in this program would be superfluous. * This program performs the Change Portion of the Application Entry program. * It will allow you to makes changes to fields in the Client File. In * this program, however, you can change the Client's Credit Card Limit * which could not be done the Application Entry Program. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. ALPHA. OBJECT-COMPUTER. ALPHA. SPECIAL-NAMES. CLASS AN-NUMERIC IS " ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789". INPUT-OUTPUT SECTION. FILE-CONTROL. COPY "SELECT_CLIENT.LIB". DATA DIVISION. FILE SECTION. COPY "FD_CLIENT.LIB". WORKING-STORAGE SECTION. * This copy library is used to store a record that is read from the Client File COPY "CLIENTREADIN.LIB". 01 HEADING1 PIC X(28) VALUE "SEARTON'S CHARGE CARD SYSTEM". 01 HEADING2 PIC X(24) VALUE "CHANGE CLIENT 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:". 05 FILLER PIC X(21) VALUE SPACES. 05 FILLER PIC X(07) VALUE "Status:". 01 INFO10. 05 FILLER PIC X(12) VALUE "14. Initial:". 05 FILLER PIC X(21) VALUE SPACES. 05 FILLER PIC X(16) VALUE "Current Balance:". 01 INFO11 PIC X(17) VALUE "15. Credit Limit:". 01 INFO12 PIC X(12) VALUE "Payment Due:". 01 PRE-INFO1. 05 FILLER PIC X(11) VALUE "Account Id:". 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). 01 V-FIELDS. 05 V-TEST-FIELD PIC X(18). 01 OUTPUT-FIELDS. 05 O-CURRENT-BALANCE PIC $$$,$$$,$$$.99. 05 O-MIN-PAY-DUE PIC $$$,$$$,$$$.99. 05 O-ACTUAL-CRD-LIMIT PIC 9(10). 05 S-CREDIT-LIMIT PIC $$,$$$,$$$,$$$. 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-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. 01 THE-ALPHABET. 05 LOWER-CASE PIC X(26) VALUE "qwertyuiopasdfghjklzxcvbnm". 05 UPPER-CASE PIC X(26) VALUE "QWERTYUIOPASDFGHJKLZXCVBNM". 01 PROMPT PIC X(09) VALUE "OK (Y/N):". 01 SPACE-CHECK PIC X(40) VALUE SPACES. 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. 01 FIELD-TO-CHANGE PIC X(20) VALUE SPACES. 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". 05 GO-FLAG PIC X VALUE "Y". 88 OKAY VALUE "Y". 88 NOT-OKAY VALUE "N". 05 EXIT-FLAG PIC X VALUE "N". 88 THE-END VALUE "Y". 05 WRITE-FLAG PIC X VALUE "N". 88 WRITE-CHANGES VALUE "Y". 05 INVALID-FLAG PIC X VALUE "N". 88 A-MATCH VALUE "N". 88 NO-MATCH VALUE "Y". 05 JUNK-FLAG PIC X VALUE "N". 88 IT-IS-JUNK VALUE "Y". 88 NOT-JUNK VALUE "N". 01 WROTE-MESSAGE PIC X(57) VALUE "Name(s) and Address have been written to the Client File.". 01 STOPPER PIC X(02) VALUE SPACES. 01 EOF-FLAG PIC X(01) VALUE "N". 01 SPACE-COUNT PIC 9(02) VALUE ZEROS. 01 JUNK-COUNTER PIC 9(02) VALUE ZEROS. 01 S-ACCOUNT-ID PIC X(10). 01 O-STATUS PIC X(09). 01 DELAY COMP-1. 01 O-LANGUAGE-CODE PIC X(07). 01 T-TO-FLOAT PIC S9(09)V99. COPY "WORKDATE.LIB". PROCEDURE DIVISION. MAINLINE. PERFORM INITIALIZATION. PERFORM MAIN-PROGRAM UNTIL NOT-OKAY. PERFORM TERMINATION. STOP RUN. INITIALIZATION. OPEN I-O CLIENT-FILE. COPY "INITDATE.LIB". DISPLAY SPACES LINE 1 ERASE TO END OF SCREEN. DISPLAY HEADING1 LINE 3 COLUMN 30. DISPLAY HEADING2 LINE 5 COLUMN 31. DISPLAY PRE-INFO1 LINE 7 COLUMN 30. MAIN-PROGRAM. DISPLAY SPACES LINE 22 ERASE TO END OF LINE. MOVE "Y" TO GO-FLAG. MOVE "Y" TO CHANGE-FLAG. PERFORM GET-TIME-DATE. PERFORM CLEAR-THE-SCREEN. PERFORM GET-ACCOUNT-ID. MOVE S-ACCOUNT-ID TO IDX-ACCOUNT-ID. PERFORM CLEAR-20. IF A-MATCH THEN DISPLAY "Change Another Client (Y/N)" LINE 20 COLUMN 30 ACCEPT GO-FLAG LINE 20 COLUMN 59 PROTECTED DEFAULT "N" INSPECT GO-FLAG CONVERTING LOWER-CASE TO UPPER-CASE END-IF. GET-ACCOUNT-ID. DISPLAY "Enter Account Id:" LINE 12 COLUMN 32. ACCEPT S-ACCOUNT-ID LINE 12 COLUMN 50 PROTECTED WITH AUTOTERMINATE DEFAULT SPACES. IF S-ACCOUNT-ID = SPACES THEN MOVE "Y" TO EXIT-FLAG ELSE MOVE S-ACCOUNT-ID TO IDX-ACCOUNT-ID READ CLIENT-FILE INTO CLIENT-READ-IN INVALID KEY PERFORM ACCOUNT-DOES-NOT-EXIST NOT INVALID KEY DISPLAY SPACES LINE 23 ERASE TO END OF LINE MOVE "N" TO INVALID-FLAG PERFORM DISPLAY-TITLES PERFORM DISPLAY-INFO PERFORM CHANGE-INFO UNTIL NO-MORE-CHANGES PERFORM PROCESS-CHANGES DISPLAY SPACES LINE 6 ERASE TO END OF SCREEN END-READ END-IF. ACCOUNT-DOES-NOT-EXIST. MOVE "Y" TO INVALID-FLAG. DISPLAY "Account ID Entered not found on file -- Please Re-enter" LINE 23 COLUMN 15. DISPLAY-TITLES. DISPLAY SPACES LINE 6 ERASE TO END OF SCREEN. 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 INFO11 LINE 13 COLUMN 47. DISPLAY INFO12 LINE 15 COLUMN 47. 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. DISPLAY-INFO. DISPLAY PRIMARY-LAST-NAME LINE 7 COLUMN 27. DISPLAY PRIMARY-FIRST-NAME LINE 8 COLUMN 27. DISPLAY PRIMARY-MID-INIT LINE 9 COLUMN 27. DISPLAY SECOND-LAST-NAME LINE 16 COLUMN 27. DISPLAY SECOND-FIRST-NAME LINE 17 COLUMN 27. DISPLAY SECOND-MID-INIT LINE 18 COLUMN 27. MOVE HOME-PHONE TO F-HOME-PHONE. MOVE F-HOME-PHONE TO O-HOME-PHONE. DISPLAY H-AREA-CODE LINE 11 COLUMN 22. DISPLAY H-EXTENSION LINE 11 COLUMN 27. DISPLAY H-NUMBER LINE 11 COLUMN 31. MOVE WORK-PHONE TO F-WORK-PHONE. MOVE F-WORK-PHONE TO O-WORK-PHONE. DISPLAY W-AREA-CODE LINE 12 COLUMN 22. DISPLAY W-EXTENSION LINE 12 COLUMN 27. DISPLAY W-NUMBER LINE 12 COLUMN 31. MOVE DATE-OF-BIRTH TO F-DATE-OF-BIRTH. MOVE F-DATE-OF-BIRTH TO O-DATE-OF-BIRTH. DISPLAY BIRTH-YEAR LINE 14 COLUMN 18. DISPLAY BIRTH-MONTH LINE 14 COLUMN 23. DISPLAY BIRTH-DAY LINE 14 COLUMN 26. MOVE POSTAL-CODE TO O-POSTAL-CODE. DISPLAY POSTAL-ONE LINE 10 COLUMN 63. DISPLAY POSTAL-TWO LINE 10 COLUMN 64. DISPLAY POSTAL-THREE LINE 10 COLUMN 65. DISPLAY POSTAL-FOUR LINE 10 COLUMN 67. DISPLAY POSTAL-FIVE LINE 10 COLUMN 68. DISPLAY POSTAL-SIX LINE 10 COLUMN 69. COPY "EVAL_STATUS.LIB". DISPLAY O-STATUS LINE 17 COLUMN 66. DISPLAY STREET LINE 7 COLUMN 59. DISPLAY CITY LINE 8 COLUMN 59. DISPLAY PROVINCE LINE 9 COLUMN 59. COPY "EVAL_LANG.LIB". DISPLAY O-LANGUAGE-CODE LINE 12 COLUMN 66. DISPLAY S-ACCOUNT-ID LINE 16 COLUMN 60. MOVE CREDIT-LIMIT TO S-CREDIT-LIMIT. DISPLAY S-CREDIT-LIMIT LINE 13 COLUMN 66 WITH CONVERSION. MOVE CURRENT-BALANCE TO T-TO-FLOAT. COMPUTE T-TO-FLOAT = ((T-TO-FLOAT / 100) + 0.004). MOVE T-TO-FLOAT TO O-CURRENT-BALANCE. DISPLAY O-CURRENT-BALANCE LINE 18 COLUMN 66 WITH CONVERSION. MOVE MIN-PAY-DUE TO T-TO-FLOAT. COMPUTE T-TO-FLOAT = ((T-TO-FLOAT / 100) + 0.004). MOVE T-TO-FLOAT TO O-MIN-PAY-DUE. DISPLAY O-MIN-PAY-DUE LINE 15 COLUMN 66 WITH CONVERSION. PROCESS-CHANGES. MOVE "N" TO WRITE-FLAG. DISPLAY "Write Changes (Y/N)" LINE 21 COLUMN 30. ACCEPT WRITE-FLAG LINE 21 COLUMN 50 PROTECTED WITH NO BLANK DEFAULT "N". INSPECT WRITE-FLAG CONVERTING LOWER-CASE TO UPPER-CASE. IF WRITE-CHANGES THEN PERFORM WRITE-TO-FILE ELSE DISPLAY SPACES LINE 21 ERASE TO END OF LINE END-IF. WRITE-TO-FILE. REWRITE CLIENT-KEYS FROM CLIENT-READ-IN INVALID KEY DISPLAY "NO WRITE!!!" LINE 22 COLUMN 25. 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 64 ERASE TO END OF LINE. COPY "TIMEDATE.LIB". BLANK-CHECK. IF SPACE-CHECK = SPACES THEN MOVE "N" TO GO-FLAG * DISPLAY "You must enter something in this field" LINE 22 COLUMN 30 ELSE MOVE "Y" TO GO-FLAG DISPLAY SPACES LINE 22 ERASE TO END OF LINE END-IF. MOVE SPACES TO SPACE-CHECK. 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. COPY "CLEAR-20.LIB". COPY "JUNK-CHECK.LIB". COPY "AN-JUNK-CHECK.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 "CREDIT-LIMIT.LIB". COPY "CHANGE-INFO.LIB". TERMINATION. DISPLAY SPACES LINE 23 ERASE TO END OF LINE. DISPLAY "" LINE 23 COLUMN 30. ACCEPT STOPPER LINE 23 COLUMN 50. CLOSE CLIENT-FILE. >> [?21h IDENTIFICATION DIVISION. PROGRAM-ID. DAILY_PAYMENTS. AUTHOR. MIKE GALLANT. * This program will print a Payments register for the day given in the parameter s. * It will consist of the Entry Number, Account Id, and Amount Payed. * It will be sorted by Branch Id and within each branch by Entry # * This program is called by DAILY-PAYMENT.CXX and allow the Operator to enter * the date to produce the register for ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. ALPHA. OBJECT-COMPUTER. ALPHA. DATA DIVISION. WORKING-STORAGE SECTION. 01 HEADING1 PIC X(27) VALUE "SEARTONS CHARGE CARD SYSTEM". 01 HEADING2 PIC X(34) VALUE "DAILY PAYMENT REGISTER SCREEN". 01 HEADING3 PIC X(22) VALUE "Enter Date of Report :". 01 HEADING4 PIC X(18) VALUE "OK (Yes/No/Exit) :". 01 PRINTING-MESSAGE PIC X(28) VALUE "Printing . . . . Please Wait". 01 DONE-MESSAGE PIC X(18) VALUE "Done! Hit Return:". 01 REPORT-DATES. 05 REPORT-YEAR PIC 9(04). 05 REPORT-MONTH PIC 9(02). 05 REPORT-DAY PIC 9(02). 01 GO-FLAG PIC X VALUE "N". 88 OKAY VALUE "Y". 88 NOT-OKAY VALUE "N". 01 CHANGE-FLAG PIC X VALUE "N". 88 MAKE-CHANGES VALUE "Y". 88 NO-CHANGES VALUE "N". 01 SPEC-LEAP-YEAR PIC 9(02) VALUE ZEROES. COPY "WORKDATE.LIB". LINKAGE SECTION. 01 PRINT-DATE PIC X(10). 01 PROMPT PIC X. PROCEDURE DIVISION USING PRINT-DATE, PROMPT. MAINLINE. MOVE "Y" TO CHANGE-FLAG. PERFORM INITIALIZATION UNTIL NO-CHANGES. MOVE REPORT-DATES TO PRINT-DATE. EXIT PROGRAM. INITIALIZATION. DISPLAY SPACES LINE 1 ERASE TO END OF SCREEN. MOVE "N" TO GO-FLAG. COPY "INITDATE.LIB". PERFORM GET-TIME-DATE. DISPLAY HEADING1 LINE 3 COLUMN 26. DISPLAY HEADING2 LINE 5 COLUMN 25. DISPLAY HEADING3 LINE 9 COLUMN 24. MOVE SYS-YEAR TO REPORT-YEAR. DISPLAY REPORT-YEAR LINE 9 COLUMN 48. DISPLAY "" LINE 22 COLUMN 27. PERFORM GET-REPORT-MONTH UNTIL OKAY. DISPLAY SPACES LINE 22 ERASE TO END OF SCREEN. DISPLAY "" LINE 22 COLUMN 28. MOVE "N" TO GO-FLAG. PERFORM GET-REPORT-DAY UNTIL OKAY. DISPLAY SPACES LINE 22 ERASE TO END OF SCREEN. DISPLAY HEADING4 LINE 11 COLUMN 31. ACCEPT PROMPT LINE 11 COLUMN 50 PROTECTED. MOVE FUNCTION UPPER-CASE(PROMPT) TO PROMPT. IF PROMPT = "Y" OR PROMPT = "E" THEN MOVE "N" TO CHANGE-FLAG ELSE MOVE "Y" TO CHANGE-FLAG END-IF. IF PROMPT = "Y" THEN DISPLAY PRINTING-MESSAGE LINE 13 COLUMN 25. COPY "GET-REPORT-DATES.LIB". COPY "TIMEDATE.LIB". >> [?21h IDENTIFICATION DIVISION. PROGRAM-ID. DAILY_SALES. AUTHOR. MIKE GALLANT. * This program will print a Sales register for the day given in the parameters. * It will consist of the Entry Number, Account Id, and Amount Purchased. * It will be sorted by Branch Id and within each branch by Entry # * This program is called by DAILY-SALE.CXX and allows the Operator to enter * the date to produce the register for ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. ALPHA. OBJECT-COMPUTER. ALPHA. DATA DIVISION. WORKING-STORAGE SECTION. 01 HEADING1 PIC X(27) VALUE "SEARTONS CHARGE CARD SYSTEM". 01 HEADING2 PIC X(34) VALUE "DAILY CHARGE SALES REGISTER SCREEN". 01 HEADING3 PIC X(22) VALUE "Enter Date of Report :". 01 HEADING4 PIC X(18) VALUE "OK (Yes/No/Exit) :". 01 PRINTING-MESSAGE PIC X(28) VALUE "Printing . . . . Please Wait". 01 DONE-MESSAGE PIC X(18) VALUE "Done! Hit Return:". 01 REPORT-DATES. 05 REPORT-YEAR PIC 9(04). 05 REPORT-MONTH PIC 9(02). 05 REPORT-DAY PIC 9(02). 01 GO-FLAG PIC X VALUE "N". 88 OKAY VALUE "Y". 88 NOT-OKAY VALUE "N". 01 CHANGE-FLAG PIC X VALUE "N". 88 MAKE-CHANGES VALUE "Y". 88 NO-CHANGES VALUE "N". 01 SPEC-LEAP-YEAR PIC 9(02) VALUE ZEROES. COPY "WORKDATE.LIB". LINKAGE SECTION. 01 PRINT-DATE PIC X(10). 01 PROMPT PIC X. PROCEDURE DIVISION USING PRINT-DATE, PROMPT. MAINLINE. MOVE "Y" TO CHANGE-FLAG. PERFORM INITIALIZATION UNTIL NO-CHANGES. MOVE REPORT-DATES TO PRINT-DATE. EXIT PROGRAM. INITIALIZATION. DISPLAY SPACES LINE 1 ERASE TO END OF SCREEN. MOVE "N" TO GO-FLAG. COPY "INITDATE.LIB". PERFORM GET-TIME-DATE. DISPLAY HEADING1 LINE 3 COLUMN 26. DISPLAY HEADING2 LINE 5 COLUMN 22. DISPLAY HEADING3 LINE 9 COLUMN 24. MOVE SYS-YEAR TO REPORT-YEAR. DISPLAY REPORT-YEAR LINE 9 COLUMN 48. DISPLAY "" LINE 22 COLUMN 27. PERFORM GET-REPORT-MONTH UNTIL OKAY. DISPLAY SPACES LINE 22 ERASE TO END OF SCREEN. DISPLAY "" LINE 22 COLUMN 28. MOVE "N" TO GO-FLAG. PERFORM GET-REPORT-DAY UNTIL OKAY. DISPLAY SPACES LINE 22 ERASE TO END OF SCREEN. DISPLAY HEADING4 LINE 11 COLUMN 31. ACCEPT PROMPT LINE 11 COLUMN 50 PROTECTED. MOVE FUNCTION UPPER-CASE(PROMPT) TO PROMPT. IF PROMPT = "Y" OR PROMPT = "E" THEN MOVE "N" TO CHANGE-FLAG ELSE MOVE "Y" TO CHANGE-FLAG END-IF. IF PROMPT = "Y" THEN DISPLAY PRINTING-MESSAGE LINE 13 COLUMN 25. COPY "GET-REPORT-DATES.LIB". COPY "TIMEDATE.LIB". >> [?21h IDENTIFICATION DIVISION. PROGRAM-ID. DAILY_RETURNS. AUTHOR. MIKE GALLANT. * This program will print a Returns register for the day given in the parameters . * It will consist of the Entry Number, Account Id, and Amount Returned. * It will be sorted by Branch Id and within each branch by Entry # * This program is called by DAILY-RETURN.CXX and allows the Operator to ented * the date to produce the register for ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. ALPHA. OBJECT-COMPUTER. ALPHA. DATA DIVISION. WORKING-STORAGE SECTION. 01 HEADING1 PIC X(27) VALUE "SEARTONS CHARGE CARD SYSTEM". 01 HEADING2 PIC X(34) VALUE "DAILY RETURNS REGISTER SCREEN". 01 HEADING3 PIC X(22) VALUE "Enter Date of Report :". 01 HEADING4 PIC X(18) VALUE "OK (Yes/No/Exit) :". 01 PRINTING-MESSAGE PIC X(28) VALUE "Printing . . . . Please Wait". 01 DONE-MESSAGE PIC X(18) VALUE "Done! Hit Return:". 01 REPORT-DATES. 05 REPORT-YEAR PIC 9(04). 05 REPORT-MONTH PIC 9(02). 05 REPORT-DAY PIC 9(02). 01 GO-FLAG PIC X VALUE "N". 88 OKAY VALUE "Y". 88 NOT-OKAY VALUE "N". 01 CHANGE-FLAG PIC X VALUE "N". 88 MAKE-CHANGES VALUE "Y". 88 NO-CHANGES VALUE "N". 01 SPEC-LEAP-YEAR PIC 9(02) VALUE ZEROES. COPY "WORKDATE.LIB". LINKAGE SECTION. 01 PRINT-DATE PIC X(10). 01 PROMPT PIC X. PROCEDURE DIVISION USING PRINT-DATE, PROMPT. MAINLINE. MOVE "Y" TO CHANGE-FLAG. PERFORM INITIALIZATION UNTIL NO-CHANGES. MOVE REPORT-DATES TO PRINT-DATE. EXIT PROGRAM. INITIALIZATION. DISPLAY SPACES LINE 1 ERASE TO END OF SCREEN. MOVE "N" TO GO-FLAG. COPY "INITDATE.LIB". PERFORM GET-TIME-DATE. DISPLAY HEADING1 LINE 3 COLUMN 26. DISPLAY HEADING2 LINE 5 COLUMN 25. DISPLAY HEADING3 LINE 9 COLUMN 24. MOVE SYS-YEAR TO REPORT-YEAR. DISPLAY REPORT-YEAR LINE 9 COLUMN 48. DISPLAY "" LINE 22 COLUMN 27. PERFORM GET-REPORT-MONTH UNTIL OKAY. DISPLAY SPACES LINE 22 ERASE TO END OF SCREEN. DISPLAY "" LINE 22 COLUMN 28. MOVE "N" TO GO-FLAG. PERFORM GET-REPORT-DAY UNTIL OKAY. DISPLAY SPACES LINE 22 ERASE TO END OF SCREEN. DISPLAY HEADING4 LINE 11 COLUMN 31. ACCEPT PROMPT LINE 11 COLUMN 50 PROTECTED. MOVE FUNCTION UPPER-CASE(PROMPT) TO PROMPT. IF PROMPT = "Y" OR PROMPT = "E" THEN MOVE "N" TO CHANGE-FLAG ELSE MOVE "Y" TO CHANGE-FLAG END-IF. IF PROMPT = "Y" THEN DISPLAY PRINTING-MESSAGE LINE 13 COLUMN 25. COPY "GET-REPORT-DATES.LIB". COPY "TIMEDATE.LIB". >> [?21h IDENTIFICATION DIVISION. PROGRAM-ID. GET_PAYMENT_DATA. AUTHOR. MIKE GALLANT. * This program gets the Payment Type and Reference ID for payments program ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. ALPHA. OBJECT-COMPUTER. ALPHA. DATA DIVISION. WORKING-STORAGE SECTION. 01 REFERENCE-ID PIC 9(04). 01 PAYMENT-TYPE PIC X. 01 OK-FLAG PIC X VALUE "N". 88 OKAY VALUE "Y". 88 NOT-OKAY VALUE "N". 01 VALID-FLAG PIC X VALUE "N". 88 VALID VALUE "Y". 88 NOT-VALID VALUE "N". * Values to be returned to C++ program LINKAGE SECTION. 01 REF-ID PIC X(04). 01 PAY-TYPE PIC X(02). PROCEDURE DIVISION USING PAY-TYPE, REF-ID. MAINLINE. MOVE "N" TO OK-FLAG, VALID-FLAG. PERFORM MAIN-PROGRAM UNTIL OKAY. MOVE REFERENCE-ID TO REF-ID. MOVE PAYMENT-TYPE TO PAY-TYPE. EXIT PROGRAM. MAIN-PROGRAM. DISPLAY "Payment Type : " LINE 14 COLUMN 51. DISPLAY "(C)ash" LINE 14 COLUMN 68. DISPLAY "Che(Q)ue" LINE 15 COLUMN 68. DISPLAY "(M)oney Order" LINE 16 COLUMN 68. ACCEPT PAYMENT-TYPE LINE 14 COLUMN 66 PROTECTED. MOVE FUNCTION UPPER-CASE(PAYMENT-TYPE) TO PAYMENT-TYPE. EVALUATE PAYMENT-TYPE WHEN "C" MOVE "Y" TO OK-FLAG MOVE 0000 TO REFERENCE-ID WHEN "Q" MOVE "Y" TO OK-FLAG PERFORM GET-REF-ID UNTIL VALID WHEN "M" MOVE "Y" TO OK-FLAG PERFORM GET-REF-ID UNTIL VALID WHEN OTHER MOVE "N" TO OK-FLAG END-EVALUATE. GET-REF-ID. DISPLAY "Reference # : " LINE 18 COLUMN 52. ACCEPT REFERENCE-ID LINE 18 COLUMN 66 PROTECTED WITH CONVERSION DEFAULT ZEROES. IF REFERENCE-ID NOT EQUAL ZEROES THEN MOVE "Y" TO VALID-FLAG ELSE MOVE "N" TO VALID-FLAG END-IF. >> [?21h IDENTIFICATION DIVISION. PROGRAM-ID. GET_ACCOUNT_ID. AUTHOR. MIKE GALLANT. * This program gets an Account Id, and searches to see that it matches * one found on file. It also checks the Status and returns these both back to C . ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. ALPHA. OBJECT-COMPUTER. ALPHA. INPUT-OUTPUT SECTION. FILE-CONTROL. COPY "SELECT_CLIENT.LIB". DATA DIVISION. FILE SECTION. COPY "FD_CLIENT.LIB". WORKING-STORAGE SECTION. COPY "CLIENTREADIN.LIB". 01 OK-FLAG PIC X VALUE "N". 88 OKAY VALUE "Y". 88 NOT-OKAY VALUE "N". 01 O-ACCOUNT-ID PIC X(10). 01 OUT-STATUS PIC S9(09) COMP. * Displays name in Compressed Format 01 PRIMARY-NAME PIC X(30). 01 DELAY COMP-1. * To display Account Entered on Screen in format XXXX-XXXXXX 01 S-ACCOUNT-ID. 05 S-ACCT1 PIC X(04). 05 FILLER PIC X VALUE "-". 05 S-ACCT2 PIC X(06). LINKAGE SECTION. 01 READ-ACCOUNT-ID PIC X(10). PROCEDURE DIVISION USING READ-ACCOUNT-ID, GIVING OUT-STATUS. COBOL-AGAIN. MOVE "N" TO OK-FLAG. MOVE 0 TO OUT-STATUS. OPEN INPUT CLIENT-FILE. PERFORM GET-ACCOUNT. PERFORM VALIDATE-ACCOUNT. CLOSE CLIENT-FILE. EXIT PROGRAM. GET-ACCOUNT. DISPLAY SPACES LINE 20 ERASE TO END OF SCREEN. DISPLAY SPACE LINE 9 COLUMN 26. DISPLAY "Enter 10 Digit Numeric Account Id" LINE 20 COLUMN 23. ACCEPT O-ACCOUNT-ID LINE 9 COLUMN 16 PROTECTED DEFAULT SPACES. MOVE O-ACCOUNT-ID(1:4) TO S-ACCT1. MOVE O-ACCOUNT-ID(5:6) TO S-ACCT2. DISPLAY S-ACCOUNT-ID LINE 9 COLUMN 16. * Check to see that Account Id entered exists on File VALIDATE-ACCOUNT. MOVE O-ACCOUNT-ID TO IDX-ACCOUNT-ID. READ CLIENT-FILE INTO CLIENT-READ-IN INVALID KEY PERFORM ACCOUNT-DOES-NOT-EXIST NOT INVALID KEY DISPLAY SPACES LINE 23 ERASE TO END OF LINE DISPLAY SPACES LINE 23 ERASE TO END OF LINE PERFORM DISPLAY-INFO PERFORM GET-STATUS MOVE ACCOUNT-ID TO READ-ACCOUNT-ID END-READ. ACCOUNT-DOES-NOT-EXIST. IF O-ACCOUNT-ID NOT EQUAL SPACES THEN MOVE 97 TO OUT-STATUS DISPLAY "Account Entered was not found on file" LINE 22 COLUMN 21 MOVE 1 TO DELAY CALL "LIB$WAIT" USING BY REFERENCE DELAY DISPLAY SPACES LINE 22 ERASE TO END OF LINE ELSE MOVE 99 TO OUT-STATUS END-IF. * Display Client Information on Screen DISPLAY-INFO. STRING PRIMARY-FIRST-NAME DELIMITED BY SPACE ' ', PRIMARY-LAST-NAME DELIMITED BY SIZE INTO PRIMARY-NAME. DISPLAY PRIMARY-NAME LINE 9 COLUMN 37. DISPLAY STREET LINE 10 COLUMN 37. DISPLAY CITY LINE 11 COLUMN 37. DISPLAY PROVINCE LINE 12 COLUMN 37. DISPLAY POSTAL-CODE LINE 12 COLUMN 40. * Store Account Status of Client to return to C++ GET-STATUS. EVALUATE ACCOUNT-STATUS WHEN "A" MOVE 0 TO OUT-STATUS WHEN "C" MOVE 1 TO OUT-STATUS WHEN "I" MOVE 2 TO OUT-STATUS WHEN "P" MOVE 3 TO OUT-STATUS WHEN "R" MOVE 4 TO OUT-STATUS WHEN "S" MOVE 5 TO OUT-STATUS WHEN "U" MOVE 6 TO OUT-STATUS WHEN OTHER MOVE 7 TO OUT-STATUS END-EVALUATE. >> [?21h IDENTIFICATION DIVISION. PROGRAM-ID. GET_ACCOUNT_NAME. AUTHOR. MIKE GALLANT. * It's purpose is to get the Account Id, and search to see that it matches * one found on file. If there is no match, A search by last name is * performed. All Names matching that entered are shown. It also checks the * Status and returns this to C. * Same as Get_Account_Id.COB but this program also has the option to search * by Last Name. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. ALPHA. OBJECT-COMPUTER. ALPHA. INPUT-OUTPUT SECTION. FILE-CONTROL. COPY "SELECT_CLIENT.LIB". DATA DIVISION. FILE SECTION. COPY "FD_CLIENT.LIB". WORKING-STORAGE SECTION. COPY "CLIENTREADIN.LIB". 01 OK-FLAG PIC X VALUE "N". 88 OKAY VALUE "Y". 88 NOT-OKAY VALUE "N". 01 OUT-STATUS PIC S9(09) COMP. 01 O-ACCOUNT-ID PIC X(10). 01 PRIMARY-NAME PIC X(30). 01 E-FOUND-FLAG PIC X. 01 FOUND-FLAG PIC X VALUE "N". 88 FOUND VALUE "Y". 88 NOT-FOUND VALUE "N". 01 EOF-FLAG PIC X VALUE "N". 88 NOT-EOF VALUE "N". 88 EOF VALUE "Y". 01 SEARCH-LAST-NAME PIC X(12) VALUE SPACES. 01 E-SEARCH-LAST-NAME PIC X(12) VALUE SPACES. 01 PROMPT PIC X VALUE SPACE. 01 DELAY COMP-1. 01 S-ACCOUNT-ID. 05 S-ACCT1 PIC X(04). 05 FILLER PIC X VALUE "-". 05 S-ACCT2 PIC X(06). LINKAGE SECTION. 01 READ-ACCOUNT-ID PIC X(10). 01 THE-PAYMENT-DUE PIC S9(11) COMP-3. PROCEDURE DIVISION USING READ-ACCOUNT-ID, THE-PAYMENT-DUE, GIVING OUT-STATUS. COBOL-AGAIN. MOVE "N" TO OK-FLAG. MOVE "N" TO EOF-FLAG. MOVE "N" TO FOUND-FLAG. MOVE 0 TO OUT-STATUS. OPEN INPUT CLIENT-FILE. PERFORM GET-ACCOUNT. PERFORM VALIDATE-ACCOUNT. DISPLAY SPACES LINE 20 ERASE TO END OF LINE. CLOSE CLIENT-FILE. EXIT PROGRAM. GET-ACCOUNT. PERFORM CLEAR-OLD-DATA. DISPLAY "Enter 10 Digit Numeric Account Id" LINE 20 COLUMN 23. ACCEPT O-ACCOUNT-ID LINE 9 COLUMN 15 PROTECTED DEFAULT SPACES. MOVE "Y" TO OK-FLAG. MOVE O-ACCOUNT-ID(1:4) TO S-ACCT1. MOVE O-ACCOUNT-ID(5:6) TO S-ACCT2. DISPLAY S-ACCOUNT-ID LINE 9 COLUMN 15. DISPLAY SPACES LINE 22 ERASE TO END OF LINE. VALIDATE-ACCOUNT. MOVE O-ACCOUNT-ID TO IDX-ACCOUNT-ID. READ CLIENT-FILE INTO CLIENT-READ-IN INVALID KEY DISPLAY SPACES LINE 9 COLUMN 15 ERASE TO END OF LINE PERFORM SEARCH-BY-LAST-NAME NOT INVALID KEY DISPLAY SPACES LINE 23 ERASE TO END OF LINE DISPLAY SPACES LINE 23 ERASE TO END OF LINE PERFORM DISPLAY-INFO PERFORM GET-STATUS MOVE ACCOUNT-ID TO READ-ACCOUNT-ID MOVE MIN-PAY-DUE TO THE-PAYMENT-DUE END-READ. SEARCH-BY-LAST-NAME. ACCEPT E-SEARCH-LAST-NAME LINE 12 COLUMN 15 PROTECTED DEFAULT SPACES. IF E-SEARCH-LAST-NAME NOT EQUAL SPACES THEN MOVE FUNCTION UPPER-CASE(E-SEARCH-LAST-NAME) TO SEARCH-LAST-NAME MOVE SEARCH-LAST-NAME TO IDX-PRIMARY-CARD-HOLDER START CLIENT-FILE KEY IS >= IDX-PRIMARY-CARD-HOLDER INVALID KEY PERFORM ACCOUNT-DOES-NOT-EXIST NOT INVALID KEY PERFORM READ-CLIENT-FILE-SEQ PERFORM DISPLAY-ALL-MATCHES UNTIL FOUND OR EOF END-START END-IF. IF EOF THEN DISPLAY "No Matches Found for String Entered" LINE 22 COLUMN 20 MOVE 1 TO DELAY CALL "LIB$WAIT" USING BY REFERENCE DELAY MOVE 99 TO OUT-STATUS. IF E-SEARCH-LAST-NAME = SPACES THEN MOVE 99 TO OUT-STATUS. READ-CLIENT-FILE-SEQ. READ CLIENT-FILE NEXT INTO CLIENT-READ-IN AT END MOVE "Y" TO EOF-FLAG. ACCOUNT-DOES-NOT-EXIST. DISPLAY "ACCOUNT NOT FOUND ON FILE " LINE 23 COLUMN 27. MOVE 1 TO DELAY. CALL "LIB$WAIT" USING BY REFERENCE DELAY. MOVE 99 TO OUT-STATUS. DISPLAY-ALL-MATCHES. PERFORM DISPLAY-INFO. DISPLAY "Is This Data Correct? (Yes/No/Exit) " LINE 22 COLUMN 22. ACCEPT E-FOUND-FLAG LINE 22 COLUMN 58 PROTECTED. MOVE FUNCTION UPPER-CASE(E-FOUND-FLAG) TO FOUND-FLAG. EVALUATE FOUND-FLAG WHEN "Y" PERFORM GET-STATUS MOVE ACCOUNT-ID TO READ-ACCOUNT-ID MOVE MIN-PAY-DUE TO THE-PAYMENT-DUE WHEN "N" PERFORM READ-CLIENT-FILE-SEQ WHEN "E" MOVE "Y" TO EOF-FLAG MOVE 99 TO OUT-STATUS WHEN OTHER PERFORM READ-CLIENT-FILE-SEQ END-EVALUATE. DISPLAY SPACES LINE 22 ERASE TO END OF LINE. DISPLAY-INFO. STRING PRIMARY-LAST-NAME DELIMITED BY SPACE ' ', PRIMARY-MID-INIT DELIMITED BY SIZE ' ', PRIMARY-FIRST-NAME DELIMITED BY SIZE INTO PRIMARY-NAME. DISPLAY PRIMARY-NAME LINE 12 COLUMN 15. DISPLAY STREET LINE 15 COLUMN 15. DISPLAY CITY LINE 16 COLUMN 15. DISPLAY PROVINCE LINE 17 COLUMN 15. DISPLAY POSTAL-CODE LINE 18 COLUMN 15. GET-STATUS. EVALUATE ACCOUNT-STATUS WHEN "A" MOVE 0 TO OUT-STATUS WHEN "C" MOVE 1 TO OUT-STATUS WHEN "I" MOVE 2 TO OUT-STATUS WHEN "P" MOVE 3 TO OUT-STATUS WHEN "R" MOVE 4 TO OUT-STATUS WHEN "S" MOVE 5 TO OUT-STATUS WHEN "U" MOVE 6 TO OUT-STATUS WHEN OTHER MOVE 7 TO OUT-STATUS END-EVALUATE. CLEAR-OLD-DATA. DISPLAY SPACES LINE 9 COLUMN 15 ERASE TO END OF LINE. DISPLAY SPACES LINE 12 COLUMN 15 ERASE TO END OF LINE. DISPLAY SPACES LINE 15 COLUMN 15 ERASE TO END OF LINE. DISPLAY SPACES LINE 16 COLUMN 15 ERASE TO END OF LINE. DISPLAY SPACES LINE 17 COLUMN 15 ERASE TO END OF LINE. DISPLAY SPACES LINE 18 COLUMN 15 ERASE TO END OF LINE. >> [?21h IDENTIFICATION DIVISION. PROGRAM-ID. INQUIRE. AUTHOR. MIKE GALLANT. * This program will allow the operator to inquire on a Client Account either * by entering their Account Id or by Last Name. If searching by Last Name, * the closest match is found and the operator continues searching through * the file until a match is found or end of file is reached. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. ALPHA. OBJECT-COMPUTER. ALPHA. INPUT-OUTPUT SECTION. FILE-CONTROL. COPY "SELECT_PAYMENT.LIB". COPY "SELECT_CLIENT.LIB". COPY "SELECT_SALES.LIB". COPY "SELECT_RETURN.LIB". COPY "SELECT_BRANCH.LIB". DATA DIVISION. FILE SECTION. COPY "FD_PAYMENT.LIB". COPY "FD_CLIENT.LIB". COPY "FD_SALES.LIB". COPY "FD_RETURN.LIB". COPY "FD_BRANCH.LIB". WORKING-STORAGE SECTION. COPY "CLIENTREADIN.LIB". COPY "SALESREADIN2.LIB". COPY "PAYMENTREADIN.LIB". COPY "RETURNREADIN.LIB". COPY "BRANCHREADIN.LIB". 01 HEADING1 PIC X(25) VALUE "GENERAL ACCOUNT INQUIRIES". * Formatted fields to display Client information on screen in "Pretty" format 01 OUTPUT-FIELDS. 05 O-ACCOUNT-ID. 10 O-ACCT-PART1 PIC X(04). 10 FILLER PIC X VALUE "-". 10 O-ACCT-PART2 PIC X(06). 05 O-LANGUAGE-CODE PIC X(07). 05 O-STATUS PIC X(09). 05 O-CURRENT-BALANCE PIC $$$,$$$,$$$.99. 05 O-PAYMENT-DUE PIC $$$,$$$,$$$.99. 05 O-CREDIT-LIMIT PIC $$$,$$$,$$$.99. 05 O-CREDIT-AVAILABLE PIC $$$,$$$,$$$.99. 05 O-DATE-OF-BIRTH. 10 O-YEAR PIC 9(04). 10 FILLER PIC X VALUE "/". 10 O-MONTH PIC 9(02). 10 FILLER PIC X VALUE "/". 10 O-DAY PIC 9(02). 05 O-PHONE-NUMBER. 10 FILLER PIC X VALUE "(". 10 O-PHONE-PART1 PIC 9(03). 10 FILLER PIC X VALUE ")". 10 O-PHONE-PART2 PIC 9(03). 10 FILLER PIC X VALUE "-". 10 O-PHONE-PART3 PIC 9(04). 05 O-STATEMENT-DAY PIC 9(02). ************************************************************************** * Search-Account-Id - Account Id Entered by operator to search by on file * Search-Last-Name - Last Name String Entered by operator to search by one fi le * E-Search-Last-Name - Used to Accept Last Name String to Search on * T-Date-Of-Birth - Used to Store Birth Date of Card Holder before displaying it * E-Found-Flag - Used to accept whether Operator has found correct account on Last Name search * T-Branch-Id - Used to Store Branch ID of Transaction before displaying it o n the screen * Primary-Name - Compress Combo of Primary Card Holders First, Middle and Las t names * Line-Count - To keep track of screen position * T-To-Float - This variable is used to convert a integer to a float data typ e for screen display * All-Nines - To fill a search field with the highest possible number to forc e an End-Of-File flag when no more matches * Line-Clear - To clear a line on the screen * T-Home-Phone - Used to store Phone Number before displaying it on the scree n * Begin-Date - The Date to begin showing transactions from * Begin-Month - The month to begin showing transactions from * Begin-Day - The Day to begin showing transactions from ************************************************************************** 01 MISC-FIELDS. 05 SEARCH-ACCOUNT-ID PIC X(10). 05 SEARCH-LAST-NAME PIC X(12) VALUE SPACES. 05 E-SEARCH-LAST-NAME PIC X(12) VALUE SPACES. 05 T-DATE-OF-BIRTH PIC 9(08). 05 E-FOUND-FLAG PIC X. 05 T-BRANCH-ID PIC X(04). 05 PRIMARY-NAME PIC X(30). 05 LINE-COUNT PIC 9(02) VALUE ZEROES. 05 T-TO-FLOAT PIC S9(09)V99. 05 ALL-NINES PIC X(24) VALUE "999999999999999999999999 ". 05 LINE-CLEAR PIC 9(02) VALUE ZEROES. 05 T-HOME-PHONE PIC 9(10). 05 BEGIN-DATE PIC X(08). 05 BEGIN-MONTH PIC 9(02). 05 BEGIN-DAY PIC 9(02). 01 FLAGZ. * Used to indicate if a match was found on file 05 FOUND-FLAG PIC X VALUE "N". 88 FOUND VALUE "Y". 88 NOT-FOUND VALUE "N". * Used to indicate End of File 05 EOF-FLAG PIC X VALUE "N". 88 NOT-EOF VALUE "N". 88 EOF VALUE "Y". * Used to test for Exit from program 05 OK-FLAG PIC X VALUE "N". 88 OKAY VALUE "Y". 88 NOT-OKAY VALUE "N". 88 I-WANT-OUT VALUE "E". 05 DOIT PIC X VALUE "N". 88 IWANTTOSEEIT VALUE "Y". * Used to indicate that there are no more records matching current account in Pa yment file 05 PAYMENT-FLAG PIC X VALUE "N". 88 PAYMENT-DONE VALUE "Y". 88 PAYMENT-NOT-DONE VALUE "N". * Used to indicate that there are no more records matching current account in Sa les file 05 SALES-FLAG PIC X VALUE "N". 88 SALES-DONE VALUE "Y". 88 SALES-NOT-DONE VALUE "N". * Used to indicate that there are no more records matching current account in Pa yment file 05 RETURN-FLAG PIC X VALUE "N". 88 RETURN-DONE VALUE "Y". 88 RETURN-NOT-DONE VALUE "N". * Used to search files for transactions matching current Account being processed 01 SEARCH-KEYZ. 05 SALES-SEARCH-KEY PIC X(24). 05 PAYMENT-SEARCH-KEY PIC X(24). 05 RETURN-SEARCH-KEY PIC X(24). * Used to format Customer Transactions into an attractive format for screen dis play 01 BILLING-OUTPUT. 05 O-TRANS-DATE. 10 O-TRANS-YEAR PIC X(04). 10 FILLER PIC X VALUE "/". 10 O-TRANS-MONTH PIC X(02). 10 FILLER PIC X VALUE "/". 10 O-TRANS-DAY PIC X(02). 05 O-TRANS-DESC PIC X(10). 05 O-TRANS-AMT PIC $$$,$$$,$$$.99. 05 O-LOCATION PIC X(15). COPY "WORKDATE.LIB". PROCEDURE DIVISION. MAINLINE. PERFORM INITIALIZATION. PERFORM MAIN-PROGRAM UNTIL I-WANT-OUT. CLOSE PAYMENT-FILE SALES-FILE RETURN-FILE CLIENT-FILE. STOP RUN. INITIALIZATION. PERFORM GET-TIME-DATE. COPY "INITDATE.LIB". MOVE "N" TO OK-FLAG. DISPLAY SPACES LINE 1 ERASE TO END OF SCREEN. DISPLAY HEADING1 LINE 1 COLUMN 28. DISPLAY "Account Id:" LINE 4 COLUMN 5. DISPLAY "Current Balance:" LINE 4 COLUMN 45. DISPLAY "Name:" LINE 5 COLUMN 5. DISPLAY "Payment Due:" LINE 5 COLUMN 45. DISPLAY "Address:" LINE 6 COLUMN 5. DISPLAY "Credit Limit:" LINE 6 COLUMN 45. DISPLAY "Credit Available:" LINE 8 COLUMN 45. DISPLAY "Phone:" LINE 9 COLUMN 5. DISPLAY "Birth Date:" LINE 10 COLUMN 5. DISPLAY "Language Code:" LINE 9 COLUMN 45. DISPLAY "Status:" LINE 10 COLUMN 45. OPEN INPUT PAYMENT-FILE CLIENT-FILE SALES-FILE RETURN-FILE. MAIN-PROGRAM. PERFORM GET-TIME-DATE. PERFORM INIT-FLAGS. PERFORM CLEAR-PREV-INFO. PERFORM GET-ACCOUNT UNTIL NOT NOT-OKAY. * If the operator entered anything other than at prompts * then check to see if account exists on file IF NOT I-WANT-OUT THEN PERFORM VALIDATE-ACCOUNT MOVE "N" TO DOIT * If a match is found, then ask operator if they want to view Billing * Statement transactions since Last Billing Statement IF FOUND THEN DISPLAY "Do you want to see billing statement? (Y/N)?" LINE 12 COLUMN 13 ACCEPT DOIT LINE 12 COLUMN 58 PROTECTED MOVE FUNCTION UPPER-CASE(DOIT) TO DOIT END-IF IF IWANTTOSEEIT THEN PERFORM SHOW-BILLING-STATEMENT END-IF END-IF. DISPLAY SPACES LINE 23 ERASE TO END OF SCREEN. DISPLAY "" LINE 23 COLUMN 26. ACCEPT DOIT LINE 23 COLUMN 53 PROTECTED. DISPLAY SPACES LINE 12 ERASE TO END OF SCREEN. INIT-FLAGS. MOVE "N" TO OK-FLAG, SALES-FLAG, PAYMENT-FLAG, RETURN-FLAG. MOVE "N" TO DOIT, FOUND-FLAG, EOF-FLAG. CLEAR-PREV-INFO. DISPLAY " " LINE 4 COLUMN 17. DISPLAY " " LINE 5 COLUMN 11. DISPLAY " " LINE 6 COLUMN 14. DISPLAY " " LINE 7 COLUMN 14. DISPLAY " " LINE 8 COLUMN 14. DISPLAY " " LINE 9 COLUMN 12. DISPLAY " " LINE 10 COLUMN 17. DISPLAY SPACES LINE 9 COLUMN 62 ERASE TO END OF LINE. DISPLAY SPACES LINE 10 COLUMN 62 ERASE TO END OF LINE. DISPLAY SPACES LINE 4 COLUMN 63 ERASE TO END OF LINE. DISPLAY SPACES LINE 5 COLUMN 63 ERASE TO END OF LINE. DISPLAY SPACES LINE 6 COLUMN 63 ERASE TO END OF LINE. DISPLAY SPACES LINE 8 COLUMN 63 ERASE TO END OF LINE. GET-ACCOUNT. DISPLAY "" LINE 20 COLUMN 23. DISPLAY "" LINE 22 COLUMN 15. ACCEPT SEARCH-ACCOUNT-ID LINE 4 COLUMN 17 PROTECTED DEFAULT SPACES. IF SEARCH-ACCOUNT-ID IS NOT NUMERIC THEN MOVE "N" TO OK-FLAG PERFORM SELECTION-PROMPT ELSE MOVE "Y" TO OK-FLAG DISPLAY SPACES LINE 20 ERASE TO END OF SCREEN END-IF. SELECTION-PROMPT. DISPLAY SPACES LINE 22 ERASE TO END OF SCREEN. DISPLAY "(S)earch by Last Name, (A)ccount Id, or (E)xit:" LINE 22 COLUMN 16. ACCEPT DOIT LINE 22 COLUMN 64 PROTECTED. MOVE FUNCTION UPPER-CASE(DOIT) TO DOIT. EVALUATE DOIT WHEN "S" MOVE "Y" TO OK-FLAG WHEN "A" MOVE "N" TO OK-FLAG WHEN "E" MOVE "E" TO OK-FLAG WHEN OTHER MOVE "N" TO OK-FLAG DISPLAY SPACES LINE 22 ERASE TO END OF SCREEN END-EVALUATE. VALIDATE-ACCOUNT. MOVE SEARCH-ACCOUNT-ID TO IDX-ACCOUNT-ID. READ CLIENT-FILE INTO CLIENT-READ-IN INVALID KEY MOVE 17 TO LINE-CLEAR PERFORM CLEAR-ACCOUNT-ID UNTIL LINE-CLEAR = 27 MOVE "Y" TO OK-FLAG IF SEARCH-ACCOUNT-ID NOT EQUAL SPACES THEN DISPLAY SPACES LINE 20 ERASE TO END OF SCREEN DISPLAY "" LINE 20 COLUMN 24 PERFORM SELECTION-PROMPT END-IF IF OKAY THEN PERFORM SEARCH-BY-LAST-NAME ELSE MOVE "N" TO FOUND-FLAG END-IF NOT INVALID KEY DISPLAY SPACES LINE 23 ERASE TO END OF LINE DISPLAY SPACES LINE 23 ERASE TO END OF LINE PERFORM DISPLAY-INFO MOVE "Y" TO FOUND-FLAG END-READ. CLEAR-ACCOUNT-ID. DISPLAY SPACES LINE 4 COLUMN LINE-CLEAR. ADD 1 TO LINE-CLEAR. SEARCH-BY-LAST-NAME. DISPLAY SPACES LINE 20 ERASE TO END OF SCREEN. DISPLAY "" LINE 20 COLUMN 23. ACCEPT E-SEARCH-LAST-NAME LINE 5 COLUMN 11 PROTECTED DEFAULT SPACES. IF E-SEARCH-LAST-NAME NOT EQUAL SPACES THEN MOVE FUNCTION UPPER-CASE(E-SEARCH-LAST-NAME) TO SEARCH-LAST-NAME MOVE SEARCH-LAST-NAME TO IDX-PRIMARY-CARD-HOLDER MOVE SPACES TO IDX-PRIMARY-CARD-HOLDER(13:20) START CLIENT-FILE KEY IS >= IDX-PRIMARY-CARD-HOLDER INVALID KEY PERFORM ACCOUNT-DOES-NOT-EXIST NOT INVALID KEY PERFORM READ-CLIENT-FILE-SEQ PERFORM DISPLAY-ALL-MATCHES UNTIL FOUND OR EOF END-START END-IF. IF EOF THEN DISPLAY SPACES LINE 22 ERASE TO END OF LINE DISPLAY "No More Matches Found for String Entered" LINE 22 COLUMN 20 ACCEPT DOIT LINE 22 COLUMN 60 PROTECTED END-IF. READ-CLIENT-FILE-SEQ. READ CLIENT-FILE NEXT INTO CLIENT-READ-IN AT END MOVE "Y" TO EOF-FLAG. ACCOUNT-DOES-NOT-EXIST. DISPLAY "" LINE 23 COLUMN 26. ACCEPT DOIT LINE 23 COLUMN 53 PROTECTED. * Keep displaying records in file until Operator Wants to Exit or has * found a match DISPLAY-ALL-MATCHES. PERFORM DISPLAY-INFO. DISPLAY SPACES LINE 22 ERASE TO END OF SCREEN. DISPLAY "Is This Data Correct? (Yes/No/Exit) " LINE 22 COLUMN 22. ACCEPT E-FOUND-FLAG LINE 22 COLUMN 58 PROTECTED. MOVE FUNCTION UPPER-CASE(E-FOUND-FLAG) TO FOUND-FLAG. EVALUATE FOUND-FLAG WHEN "Y" MOVE "Y" TO FOUND-FLAG WHEN "N" PERFORM READ-CLIENT-FILE-SEQ WHEN "E" MOVE "Y" TO EOF-FLAG WHEN OTHER PERFORM READ-CLIENT-FILE-SEQ END-EVALUATE. DISPLAY SPACES LINE 22 ERASE TO END OF LINE. * Display Client Information on Screen DISPLAY-INFO. PERFORM CLEAR-PREV-INFO. DISPLAY SPACES LINE 20 ERASE TO END OF SCREEN. MOVE ACCOUNT-ID(1:4) TO O-ACCT-PART1. MOVE ACCOUNT-ID(5:6) TO O-ACCT-PART2. DISPLAY O-ACCOUNT-ID LINE 4 COLUMN 17. MOVE SPACES TO PRIMARY-NAME. STRING PRIMARY-FIRST-NAME DELIMITED BY SPACE ' ', PRIMARY-MID-INIT DELIMITED BY SIZE '. ', PRIMARY-LAST-NAME DELIMITED BY SIZE INTO PRIMARY-NAME. DISPLAY PRIMARY-NAME LINE 5 COLUMN 11. DISPLAY STREET LINE 6 COLUMN 14. DISPLAY CITY LINE 7 COLUMN 14. DISPLAY PROVINCE LINE 8 COLUMN 14. DISPLAY POSTAL-CODE LINE 8 COLUMN 19. MOVE HOME-PHONE TO T-HOME-PHONE. MOVE T-HOME-PHONE(1:3) TO O-PHONE-PART1. MOVE T-HOME-PHONE(4:3) TO O-PHONE-PART2. MOVE T-HOME-PHONE(7:4) TO O-PHONE-PART3. DISPLAY O-PHONE-NUMBER LINE 9 COLUMN 13. * Convert all Money Amounts to dollars and cents format MOVE CURRENT-BALANCE TO T-TO-FLOAT. COMPUTE T-TO-FLOAT = (T-TO-FLOAT / 100). MOVE T-TO-FLOAT TO O-CURRENT-BALANCE. MOVE MIN-PAY-DUE TO T-TO-FLOAT. COMPUTE T-TO-FLOAT = (T-TO-FLOAT / 100). MOVE T-TO-FLOAT TO O-PAYMENT-DUE. MOVE CREDIT-LIMIT TO O-CREDIT-LIMIT. MOVE ACTUAL-CRD-LIMIT TO T-TO-FLOAT. COMPUTE T-TO-FLOAT = (T-TO-FLOAT / 100). MOVE T-TO-FLOAT TO O-CREDIT-AVAILABLE. DISPLAY O-CURRENT-BALANCE LINE 4 COLUMN 63. DISPLAY O-PAYMENT-DUE LINE 5 COLUMN 63. DISPLAY O-CREDIT-LIMIT LINE 6 COLUMN 63. DISPLAY O-CREDIT-AVAILABLE LINE 8 COLUMN 63. COPY "EVAL_LANG.LIB". DISPLAY O-LANGUAGE-CODE LINE 9 COLUMN 62. COPY "EVAL_STATUS.LIB". DISPLAY O-STATUS LINE 10 COLUMN 62. MOVE DATE-OF-BIRTH TO T-DATE-OF-BIRTH. MOVE T-DATE-OF-BIRTH(1:4) TO O-YEAR. MOVE T-DATE-OF-BIRTH(5:2) TO O-MONTH. MOVE T-DATE-OF-BIRTH(7:2) TO O-DAY. DISPLAY O-DATE-OF-BIRTH LINE 10 COLUMN 17. SHOW-BILLING-STATEMENT. MOVE "N" TO RETURN-FLAG, SALES-FLAG, PAYMENT-FLAG. * Get Date to begin displaying transaction at (Their Billing Day - 1 Month) MOVE SYS-DATE TO BEGIN-DATE. MOVE STATEMENT-DAY TO O-STATEMENT-DAY. MOVE O-STATEMENT-DAY TO BEGIN-DAY. MOVE BEGIN-DATE(5:2) TO BEGIN-MONTH. IF SYS-DATE(7:2) < BEGIN-DAY THEN SUBTRACT 1 FROM BEGIN-MONTH. IF BEGIN-MONTH = ZEROES THEN MOVE 12 TO BEGIN-MONTH. MOVE BEGIN-MONTH TO BEGIN-DATE(5:2). MOVE BEGIN-DAY TO BEGIN-DATE(7:2). MOVE 16 TO LINE-COUNT. DISPLAY SPACES LINE 12 ERASE TO END OF SCREEN. DISPLAY "BILLING STATEMENT" LINE 12 COLUMN 31. DISPLAY "Transaction" LINE 14 COLUMN 14. DISPLAY "Transaction" LINE 14 COLUMN 48. DISPLAY "Transaction" LINE 14 COLUMN 63. DISPLAY "Date" LINE 15 COLUMN 14. DISPLAY "Location" LINE 15 COLUMN 29. DISPLAY "Description" LINE 15 COLUMN 48. DISPLAY "Amount" LINE 15 COLUMN 68. * Set Up Indexes to get first transaction MOVE ACCOUNT-ID TO IDX-SALES, IDX-PAYMENT, IDX-RETURN. MOVE BEGIN-DATE TO IDX-SALES(11:8), IDX-PAYMENT(11:8), IDX-RETURN(11:8). MOVE ZEROES TO IDX-SALES(19:6), IDX-PAYMENT(19:6), IDX-RETURN(19:6). PERFORM SEARCH-SALES-FILE. PERFORM SEARCH-PAYMENT-FILE. PERFORM SEARCH-RETURN-FILE. * Get transactions for Account until there are no matches in all three files PERFORM DISPLAY-BILLINGS UNTIL PAYMENT-DONE AND SALES-DONE AND RETURN-DONE. DISPLAY-BILLINGS. IF SALES-SEARCH-KEY < PAYMENT-SEARCH-KEY AND SALES-SEARCH-KEY < RETURN-SEARC H-KEY AND SALES-NOT-DONE THEN PERFORM MOVE-SALES-TO-OUTPUT PERFORM SEARCH-SALES-FILE ELSE IF PAYMENT-SEARCH-KEY < RETURN-SEARCH-KEY AND PAYMENT-NOT-DONE PERFORM MOVE-PAYMENT-TO-OUTPUT PERFORM SEARCH-PAYMENT-FILE ELSE IF RETURN-NOT-DONE PERFORM MOVE-RETURN-TO-OUTPUT PERFORM SEARCH-RETURN-FILE END-IF END-IF END-IF. * Display Sales Transactions On screen MOVE-SALES-TO-OUTPUT. PERFORM SCREEN-PLACEMENT. MOVE SALES-SEARCH-KEY(11:4) TO O-TRANS-YEAR. MOVE SALES-SEARCH-KEY(15:2) TO O-TRANS-MONTH. MOVE SALES-SEARCH-KEY(17:2) TO O-TRANS-DAY. DISPLAY O-TRANS-DATE LINE LINE-COUNT COLUMN 14. MOVE S-BRANCH-ID TO T-BRANCH-ID. PERFORM GET-BRANCH-ID. MOVE "Sale" TO O-TRANS-DESC. DISPLAY O-TRANS-DESC LINE LINE-COUNT COLUMN 48. MOVE PURCHASE-AMT TO T-TO-FLOAT. COMPUTE T-TO-FLOAT = (T-TO-FLOAT / 100). MOVE T-TO-FLOAT TO O-TRANS-AMT. DISPLAY O-TRANS-AMT LINE LINE-COUNT COLUMN 63. * ACCEPT DOIT LINE 1 COLUMN 1 PROTECTED. * Display Payment Transactions on screen MOVE-PAYMENT-TO-OUTPUT. PERFORM SCREEN-PLACEMENT. MOVE PAYMENT-SEARCH-KEY(11:4) TO O-TRANS-YEAR. MOVE PAYMENT-SEARCH-KEY(15:2) TO O-TRANS-MONTH. MOVE PAYMENT-SEARCH-KEY(17:2) TO O-TRANS-DAY. DISPLAY O-TRANS-DATE LINE LINE-COUNT COLUMN 14. MOVE P-BRANCH-ID TO T-BRANCH-ID. PERFORM GET-BRANCH-ID. MOVE "Payment" TO O-TRANS-DESC. DISPLAY O-TRANS-DESC LINE LINE-COUNT COLUMN 48. MOVE PAYMENT-AMT TO T-TO-FLOAT. COMPUTE T-TO-FLOAT = (T-TO-FLOAT / 100). MOVE T-TO-FLOAT TO O-TRANS-AMT. DISPLAY O-TRANS-AMT LINE LINE-COUNT COLUMN 63. * ACCEPT DOIT LINE 1 COLUMN 1 PROTECTED. * Display Return Transactions on Screen MOVE-RETURN-TO-OUTPUT. PERFORM SCREEN-PLACEMENT. MOVE RETURN-SEARCH-KEY(11:4) TO O-TRANS-YEAR. MOVE RETURN-SEARCH-KEY(15:2) TO O-TRANS-MONTH. MOVE RETURN-SEARCH-KEY(17:2) TO O-TRANS-DAY. DISPLAY O-TRANS-DATE LINE LINE-COUNT COLUMN 14. MOVE R-BRANCH-ID TO T-BRANCH-ID. PERFORM GET-BRANCH-ID. MOVE "Return" TO O-TRANS-DESC. DISPLAY O-TRANS-DESC LINE LINE-COUNT COLUMN 48. MOVE RETURN-AMT TO T-TO-FLOAT. COMPUTE T-TO-FLOAT = (T-TO-FLOAT / 100). MOVE T-TO-FLOAT TO O-TRANS-AMT. DISPLAY O-TRANS-AMT LINE LINE-COUNT COLUMN 63. * ACCEPT DOIT LINE 1 COLUMN 1 PROTECTED. COPY "SEARCH-TRANS-FILES.LIB". * Check for End of Screen, If End of Screen, Display message and wait * until user hits to display next screen of transactions SCREEN-PLACEMENT. ADD 1 TO LINE-COUNT. IF LINE-COUNT > 22 THEN DISPLAY "" LINE 23 COLUMN 21 ACCEPT DOIT LINE 23 COLUMN 58 DISPLAY SPACES LINE 17 ERASE TO END OF SCREEN MOVE 17 TO LINE-COUNT END-IF. * Decode Branch Id to Full City Name GET-BRANCH-ID. PERFORM SEARCH-FOR-BRANCH. DISPLAY O-LOCATION LINE LINE-COUNT COLUMN 29. COPY "SEARCHBRANCH.LIB". COPY "TIMEDATE.LIB". >> [?21h IDENTIFICATION DIVISION. PROGRAM-ID. INACTIVE. AUTHOR. MIKE GALLANT. * This program will print the Inactive Client list for the current date. * It will consist of the Account Number, Name of Primary Card Holder and * Last Purchase Date. It will be sorted by Account ID and provide * the total number of inactive accounts printed. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. ALPHA. OBJECT-COMPUTER. ALPHA. INPUT-OUTPUT SECTION. FILE-CONTROL. COPY "SELECT_CLIENT.LIB". SELECT PRINTER ASSIGN TO "INACTIVE.LTR". DATA DIVISION. FILE SECTION. COPY "FD_CLIENT.LIB". FD PRINTER RECORD CONTAINS 80 CHARACTERS LABEL RECORDS OMITTED. 01 PRINT-LINE PIC X(80). WORKING-STORAGE SECTION. COPY "CLIENTREADIN.LIB". 01 HEADING1 PIC X(27) VALUE "SEARTONS CHARGE CARD SYSTEM". 01 HEADING2 PIC X(32) VALUE "INACTIVE CLIENT LIST AND LETTER". 01 HEADING3. 05 FILLER PIC X(16) VALUE "DATE OF REPORT: ". 05 REPORT-YEAR PIC X(04). 05 FILLER PIC X VALUE "-". 05 REPORT-MONTH PIC X(02). 05 FILLER PIC X VALUE "-". 05 REPORT-DAY PIC X(02). 01 HEADING4 PIC X(23) VALUE "Are You Sure (Yes/No) :". 01 PRINTING-MESSAGE PIC X(28) VALUE "Printing . . . . Please Wait". 01 DONE-MESSAGE PIC X(18) VALUE "Done! Hit Return:". 01 GO-FLAG PIC X VALUE "N". 88 OKAY VALUE "Y". 88 NOT-OKAY VALUE "N". 01 CHANGE-FLAG PIC X VALUE "N". 88 MAKE-CHANGES VALUE "Y". 88 NO-CHANGES VALUE "N". 01 EOF-FLAG PIC X VALUE "N". 88 EOF VALUE "Y". 88 NOT-EOF VALUE "N". 01 SPEC-LEAP-YEAR PIC 9(02) VALUE ZEROES. 01 DAYS-SINCE-PURCHASE PIC 9(08) VALUE ZEROES. 01 PROMPT PIC X VALUE SPACE. 01 CURRENT-DATE PIC 9(08) VALUE ZEROS. 01 O-LAST-PURCHASE-DATE PIC 9(08). COPY "WORKDATE.LIB". COPY "INACTIVE_LETTER.LIB". PROCEDURE DIVISION. MAINLINE. MOVE "Y" TO CHANGE-FLAG. PERFORM INITIALIZATION UNTIL NO-CHANGES. IF PROMPT = "Y" THEN PERFORM MAIN-PROGRAM. DISPLAY "Done! Hit Return" LINE 18 COLUMN 33. ACCEPT PROMPT LINE 18 COLUMN 52 PROTECTED. STOP RUN. INITIALIZATION. DISPLAY SPACES LINE 1 ERASE TO END OF SCREEN. MOVE "N" TO GO-FLAG. COPY "INITDATE.LIB". PERFORM GET-TIME-DATE. MOVE THE-YEAR TO REPORT-YEAR. MOVE THE-MONTH TO REPORT-MONTH. MOVE THE-DAY TO REPORT-DAY. DISPLAY HEADING1 LINE 3 COLUMN 26. DISPLAY HEADING2 LINE 5 COLUMN 26. DISPLAY HEADING3 LINE 6 COLUMN 27. DISPLAY HEADING4 LINE 8 COLUMN 27. ACCEPT PROMPT LINE 8 COLUMN 51 PROTECTED. MOVE FUNCTION UPPER-CASE(PROMPT) TO PROMPT. IF PROMPT = "Y" OR PROMPT = "N" THEN MOVE "N" TO CHANGE-FLAG ELSE MOVE "Y" TO CHANGE-FLAG END-IF. * If Operator wants Report made, then Call Quiz program to Print Inactive Clien t List IF PROMPT = "Y" THEN DISPLAY PRINTING-MESSAGE LINE 13 COLUMN 25 CALL "LIB$SPAWN" USING BY DESCRIPTOR "@INACTIVE.COM" END-IF. DISPLAY SPACES LINE 14 ERASE TO END OF SCREEN. MAIN-PROGRAM. MOVE SYS-YEAR TO CURRENT-DATE(1:4). MOVE SYS-MONTH TO CURRENT-DATE(5:2). MOVE SYS-DAY TO CURRENT-DATE(7:2). OPEN I-O CLIENT-FILE. OPEN OUTPUT PRINTER. MOVE "1000000000" TO IDX-ACCOUNT-ID. START CLIENT-FILE KEY IS >= IDX-ACCOUNT-ID INVALID KEY DISPLAY "INVALID DATA" LINE 5 COLUMN 10 NOT INVALID KEY PERFORM READ-CLIENT-FILE-SEQ. PERFORM GET-INACTIVE-CLIENTS UNTIL EOF. CLOSE CLIENT-FILE PRINTER. * Get all Inactive Clients and Produce a Letter to send to each one GET-INACTIVE-CLIENTS. MOVE LAST-PURCH-DATE TO O-LAST-PURCHASE-DATE. COMPUTE DAYS-SINCE-PURCHASE = FUNCTION INTEGER-OF-DATE(CURRENT-DATE) - FUNCTION INTEGER-OF-DATE(O-LAST-PURCHASE-DATE). IF DAYS-SINCE-PURCHASE > 90 THEN PERFORM PRINT-INACTIVE-LETTER PERFORM CHANGE-ACCOUNT-STATUS END-IF. PERFORM READ-CLIENT-FILE-SEQ. COPY "INACTIVE.LIB". CHANGE-ACCOUNT-STATUS. MOVE "I" TO ACCOUNT-STATUS. REWRITE CLIENT-KEYS FROM CLIENT-READ-IN INVALID KEY DISPLAY "Write cannot be made" LINE 23 COLUMN 30. READ-CLIENT-FILE-SEQ. READ CLIENT-FILE NEXT INTO CLIENT-READ-IN AT END MOVE "Y" TO EOF-FLAG. COPY "TIMEDATE.LIB". >> [?21h IDENTIFICATION DIVISION. PROGRAM-ID. INTEREST. AUTHOR. MIKE GALLANT. * This program allows changing of the yearly interest rate. If the interest * rate entered is the same as before, no changes are made. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. ALPHA. OBJECT-COMPUTER. ALPHA. INPUT-OUTPUT SECTION. FILE-CONTROL. COPY "SELECT_SEARTON.LIB". DATA DIVISION. FILE SECTION. COPY "FD_SEARTON.LIB". WORKING-STORAGE SECTION. COPY "SEARTONREADIN.LIB". 01 HEADING1 PIC X(28) VALUE "SEARTON'S CHARGE CARD SYSTEM". 01 HEADING2 PIC X(20) VALUE "INTEREST RATE CHANGE". 01 PROMPT PIC X(09) VALUE "OK (Y/N):". 01 DISPLAY-MESSAGES. 05 NOW-ACTIVE-MESSAGE PIC X(34) VALUE "Interest rate has now been changed". 05 CORRECT-MESSAGE PIC X(34) VALUE "Change Interest Rate (Y/N)". 05 ANY-KEY-MESSAGE PIC X(21) VALUE "". 01 FLAGZ. 05 EXIT-FLAG PIC X VALUE "N". 88 EXIT-NOW VALUE "Y". 88 EXIT-LATER VALUE "N". 05 WRITE-FLAG PIC X VALUE "N". 88 WRITE-IT VALUE "Y". 88 DONT-WRITE-IT VALUE "N". * Used to set whether Interest rate entered is valid or not 05 OK-FLAG PIC X VALUE "N". 88 OKAY VALUE "Y". 88 NOT-OKAY VALUE "N". 01 DELAY COMP-1. 01 INTEREST-RATE PIC 9(04) VALUE ZEROES. 88 VALID-RATES VALUES 500 THRU 6000. 01 TEMP-INT-RATE PIC 9(08). 01 T-TO-FLOAT PIC 9(06)V99. 01 NEW-INTEREST-RATE. 05 INTEREST-RATE1 PIC X(02) VALUE SPACES. 05 INTEREST-RATE2 PIC X(02) VALUE SPACES. COPY "WORKDATE.LIB". COPY "ALPHABET.LIB". PROCEDURE DIVISION. MAINLINE. PERFORM INITIALIZATION. PERFORM MAIN-PROGRAM. PERFORM TERMINATION. STOP RUN. INITIALIZATION. PERFORM INIT-FLAGS. OPEN I-O SEARTONS-WORK. COPY "INITDATE.LIB". READ SEARTONS-WORK INTO SEARTON-READ-IN AT END DISPLAY " " LINE 1 COLUMN 1. MOVE INT-RATE TO TEMP-INT-RATE. COMPUTE T-TO-FLOAT = ((TEMP-INT-RATE / 100) + 0.004). DISPLAY SPACES LINE 1 ERASE TO END OF SCREEN. DISPLAY HEADING1 LINE 3 COLUMN 29. DISPLAY HEADING2 LINE 5 COLUMN 35. DISPLAY "Current Interest Rate: " LINE 13 COLUMN 28. DISPLAY T-TO-FLOAT LINE 13 COLUMN 51 WITH CONVERSION. DISPLAY "%" LINE 13 COLUMN 60. INIT-FLAGS. MOVE "N" TO OK-FLAG. MOVE "N" TO EXIT-FLAG. MOVE "N" TO WRITE-FLAG. MAIN-PROGRAM. PERFORM GET-TIME-DATE. MOVE "N" TO EXIT-FLAG. DISPLAY SPACES LINE 14 ERASE TO END OF SCREEN. PERFORM GET-NEW-INTEREST-RATE. GET-NEW-INTEREST-RATE. DISPLAY "." LINE 14 COLUMN 49. DISPLAY "%" LINE 14 COLUMN 52. MOVE "N" TO OK-FLAG. PERFORM GET-RATES UNTIL OKAY. MOVE NEW-INTEREST-RATE TO INTEREST-RATE. IF INTEREST-RATE = INT-RATE THEN MOVE "Y" TO EXIT-FLAG ELSE MOVE "N" TO EXIT-FLAG PERFORM WRITE-INTEREST-RATE END-IF. GET-RATES. DISPLAY "New Interest Rate:" LINE 14 COLUMN 28. ACCEPT INTEREST-RATE1 LINE 14 COLUMN 47 PROTECTED WITH AUTOTERMINATE. ACCEPT INTEREST-RATE2 LINE 14 COLUMN 50 PROTECTED WITH AUTOTERMINATE. IF INTEREST-RATE1 IS NOT NUMERIC OR INTEREST-RATE2 IS NOT NUMERIC THEN MOVE "N" TO OK-FLAG DISPLAY "Interest Rate Entered must be Numeric" LINE 22 COLUMN 23 ELSE DISPLAY SPACES LINE 22 ERASE TO END OF LINE MOVE "Y" TO OK-FLAG END-IF. COPY "TIMEDATE.LIB". * Prompt Operator to make sure that they want to change current interest rate WRITE-INTEREST-RATE. DISPLAY "Write Interest Rate?" LINE 19 COLUMN 28. ACCEPT WRITE-FLAG LINE 19 COLUMN 49 PROTECTED. INSPECT WRITE-FLAG CONVERTING LOWER-CASE TO UPPER-CASE. IF WRITE-FLAG = "Y" THEN MOVE INTEREST-RATE TO INT-RATE REWRITE SEARTONS-WORK-FILE FROM SEARTON-READ-IN MOVE 3 TO DELAY DISPLAY "Writing Interest Rate to file" LINE 22 COLUMN 20 CALL "LIB$WAIT" USING BY REFERENCE DELAY DISPLAY SPACES LINE 22 ERASE TO END OF LINE ELSE MOVE "Y" TO EXIT-FLAG END-IF. TERMINATION. IF EXIT-NOW THEN DISPLAY "Interest Rate Not Changed" LINE 20 COLUMN 27 ELSE DISPLAY "Interest Rate has been Changed and Written to File" LINE 20 COL UMN 15 END-IF. DISPLAY SPACES LINE 23 ERASE TO END OF LINE. DISPLAY "" LINE 23 COLUMN 30. ACCEPT EXIT-FLAG LINE 23 COLUMN 50 PROTECTED. CLOSE SEARTONS-WORK. >> [?21h IDENTIFICATION DIVISION. PROGRAM-ID. QUARTER. AUTHOR. MIKE GALLANT. * This program will print a Quarterly Summary Report for the current date. * It will consist of the Account Number, Name of Primary Card Holder and * Last Purchase Date. It will be sorted by Account ID and provide * the total number of inactive accounts printed. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. ALPHA. OBJECT-COMPUTER. ALPHA. DATA DIVISION. WORKING-STORAGE SECTION. 01 HEADING1 PIC X(27) VALUE "SEARTONS CHARGE CARD SYSTEM". 01 HEADING2 PIC X(24) VALUE "QUARTERLY SUMMARY REPORT". 01 HEADING3. 05 FILLER PIC X(16) VALUE "DATE OF REPORT: ". 05 REPORT-YEAR PIC X(04). 05 FILLER PIC X VALUE "-". 05 REPORT-MONTH PIC X(02). 05 FILLER PIC X VALUE "-". 05 REPORT-DAY PIC X(02). 01 HEADING4 PIC X(23) VALUE "Are You Sure (Yes/No) :". 01 PRINTING-MESSAGE PIC X(28) VALUE "Printing . . . . Please Wait". 01 DONE-MESSAGE PIC X(18) VALUE "Done! Hit Return:". 01 GO-FLAG PIC X VALUE "N". 88 OKAY VALUE "Y". 88 NOT-OKAY VALUE "N". 01 CHANGE-FLAG PIC X VALUE "N". 88 MAKE-CHANGES VALUE "Y". 88 NO-CHANGES VALUE "N". 01 SPEC-LEAP-YEAR PIC 9(02) VALUE ZEROES. 01 PROMPT PIC X VALUE SPACE. COPY "WORKDATE.LIB". PROCEDURE DIVISION. MAINLINE. MOVE "Y" TO CHANGE-FLAG. PERFORM INITIALIZATION UNTIL NO-CHANGES. PERFORM MAIN-PROGRAM. STOP RUN. INITIALIZATION. DISPLAY SPACES LINE 1 ERASE TO END OF SCREEN. MOVE "N" TO GO-FLAG. COPY "INITDATE.LIB". PERFORM GET-TIME-DATE. MOVE THE-YEAR TO REPORT-YEAR. MOVE THE-MONTH TO REPORT-MONTH. MOVE THE-DAY TO REPORT-DAY. DISPLAY HEADING1 LINE 3 COLUMN 26. DISPLAY HEADING2 LINE 5 COLUMN 28. DISPLAY HEADING3 LINE 6 COLUMN 27. DISPLAY HEADING4 LINE 8 COLUMN 27. ACCEPT PROMPT LINE 8 COLUMN 51 PROTECTED. MOVE FUNCTION UPPER-CASE(PROMPT) TO PROMPT. IF PROMPT = "Y" OR PROMPT = "N" THEN MOVE "N" TO CHANGE-FLAG ELSE MOVE "Y" TO CHANGE-FLAG END-IF. IF PROMPT = "Y" THEN DISPLAY PRINTING-MESSAGE LINE 13 COLUMN 25 CALL "LIB$SPAWN" USING BY DESCRIPTOR "@QUARTER.COM" END-IF. DISPLAY SPACES LINE 14 ERASE TO END OF SCREEN. MAIN-PROGRAM. DISPLAY "Done! Hit Return" LINE 18 COLUMN 33. ACCEPT PROMPT LINE 18 COLUMN 51 PROTECTED. COPY "TIMEDATE.LIB". >> [?21h IDENTIFICATION DIVISION. PROGRAM-ID. REJECTED. AUTHOR. MIKE GALLANT. * This program is to send rejected clients and a letter to inform them that * they have been denied credit. The Account Status is also changed to Rejected * at this time. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. ALPHA. OBJECT-COMPUTER. ALPHA. INPUT-OUTPUT SECTION. FILE-CONTROL. COPY "SELECT_CLIENT.LIB". SELECT PRINTER ASSIGN TO "REJECTED.LTR". DATA DIVISION. FILE SECTION. COPY "FD_CLIENT.LIB". FD PRINTER RECORD CONTAINS 80 CHARACTERS LABEL RECORDS OMITTED. 01 PRINT-LINE PIC X(80). WORKING-STORAGE SECTION. COPY "CLIENTREADIN.LIB". 01 HEADING1 PIC X(28) VALUE "SEARTON'S CHARGE CARD SYSTEM". 01 HEADING2 PIC X(20) VALUE "REJECTED APPLICATION". 01 INFO2 PIC X(18) VALUE "Client Account Id:". 01 OTHER-INFO. 05 D-PRIMARY PIC X(05) VALUE "Name:". 05 D-STREET PIC X(07) VALUE "Street:". 05 D-CITY PIC X(05) VALUE "City:". 05 D-PROV PIC X(06) VALUE "Prov.:". 05 D-POSTAL PIC X(12) VALUE "Postal Code:". 01 PROMPT PIC X(09) VALUE "OK (Y/N):". 01 DISPLAY-MESSAGES. 05 NOW-ACTIVE-MESSAGE PIC X(30) VALUE "Customer Status is now active.". 05 PRINTING-MESSAGE PIC X(39) VALUE "Rejection Letter is now being printed.". 05 SEARCH-MESSAGE PIC X(29) VALUE "Searching for Client Name....". 05 NO-MATCH-MESSAGE PIC X(22) VALUE "No match found on file". 05 CORRECT-MESSAGE PIC X(34) VALUE "Is this the correct account? (Y/N)". 05 ANY-KEY-MESSAGE PIC X(21) VALUE "". 01 OUTPUT-LINE. 05 O-PRIMARY-LAST-NAME PIC X(12). 05 FILLER PIC X(02) VALUE SPACES. 05 O-STREET PIC X(18). 05 FILLER PIC X(02) VALUE SPACES. 05 O-CITY PIC X(18). 05 FILLER PIC X(02) VALUE SPACES. 05 O-PROVINCE PIC X(02). 05 FILLER PIC X(02) VALUE SPACES. 05 O-POSTAL-CODE PIC X(06). 01 FLAGZ. 05 EOF-FLAG PIC X VALUE "N". 88 EOF VALUE "Y". 05 EXIT-FLAG PIC X VALUE "N". 88 EXIT-NOW VALUE "Y". 88 EXIT-LATER VALUE "N". 05 WRITE-FLAG PIC X VALUE "N". 88 WRITE-IT VALUE "Y". 88 DONT-WRITE-IT VALUE "N". 05 MATCH-FLAG PIC X VALUE "N". 88 A-MATCH VALUE "Y". 88 NOT-A-MATCH VALUE "N". 01 S-ACCOUNT-ID PIC 9(10) VALUE ZEROES. 01 DELAY COMP-1. * To display card holders name in compact format 01 PRIMARY-USER-NAME PIC X(32). COPY "REJECT_LETTER.LIB". COPY "WORKDATE.LIB". COPY "ALPHABET.LIB". PROCEDURE DIVISION. MAINLINE. PERFORM INITIALIZATION. PERFORM MAIN-PROGRAM UNTIL EXIT-NOW. PERFORM TERMINATION. STOP RUN. INITIALIZATION. OPEN I-O CLIENT-FILE OUTPUT PRINTER. COPY "INITDATE.LIB". DISPLAY SPACES LINE 1 ERASE TO END OF SCREEN. DISPLAY HEADING1 LINE 3 COLUMN 29. DISPLAY HEADING2 LINE 5 COLUMN 35. DISPLAY INFO2 LINE 7 COLUMN 8. MAIN-PROGRAM. PERFORM GET-TIME-DATE. MOVE "N" TO EXIT-FLAG. DISPLAY SPACES LINE 8 ERASE TO END OF SCREEN. PERFORM GET-ACCOUNT-INFO. IF EXIT-LATER THEN PERFORM SEARCH-FOR-ACCOUNT-ID IF A-MATCH THEN PERFORM DISPLAY-ACCOUNT-DATA DISPLAY CORRECT-MESSAGE LINE 22 COLUMN 22 ACCEPT WRITE-FLAG LINE 22 COLUMN 57 PROTECTED WITH NO BLANK DEFAULT "N" INSPECT WRITE-FLAG CONVERTING LOWER-CASE TO UPPER-CASE IF WRITE-IT THEN PERFORM WRITE-REJECTED-CLIENT DISPLAY ANY-KEY-MESSAGE LINE 23 COLUMN 29 END-IF END-IF END-IF. GET-ACCOUNT-INFO. DISPLAY "Type to exit" LINE 22 COLUMN 30. ACCEPT S-ACCOUNT-ID LINE 7 COLUMN 27 PROTECTED WITH CONVERSION DEFAULT ZEROES. DISPLAY SPACES LINE 22 ERASE TO END OF SCREEN. IF S-ACCOUNT-ID = ZEROES THEN MOVE "Y" TO EXIT-FLAG ELSE MOVE "N" TO EXIT-FLAG END-IF. SEARCH-FOR-ACCOUNT-ID. MOVE S-ACCOUNT-ID TO IDX-ACCOUNT-ID. MOVE "Y" TO MATCH-FLAG. READ CLIENT-FILE INTO CLIENT-READ-IN INVALID KEY PERFORM NOT-FOUND MOVE "N" TO MATCH-FLAG NOT INVALID KEY PERFORM CHECK-FOR-PENDING END-READ. CHECK-FOR-PENDING. IF ACCOUNT-STATUS NOT EQUAL "P" THEN MOVE "N" TO MATCH-FLAG DISPLAY "Account ID Entered is Invalid" LINE 22 COLUMN 10 MOVE 2 TO DELAY CALL "LIB$WAIT" USING BY REFERENCE DELAY END-IF. NOT-FOUND. DISPLAY NO-MATCH-MESSAGE LINE 22 COLUMN 10. MOVE 2 TO DELAY. CALL "LIB$WAIT" USING BY REFERENCE DELAY. DISPLAY-ACCOUNT-DATA. MOVE SPACES TO PRIMARY-USER-NAME. STRING PRIMARY-CARD-HOLDER(13:18) DELIMITED BY " " " " DELIMITED BY SIZE PRIMARY-CARD-HOLDER(31:2) DELIMITED BY " " " " DELIMITED BY SIZE PRIMARY-CARD-HOLDER(1:12) DELIMITED BY " " INTO PRIMARY-USER-NAME. DISPLAY D-PRIMARY LINE 10 COLUMN 15. DISPLAY D-STREET LINE 11 COLUMN 15. DISPLAY D-CITY LINE 12 COLUMN 15. DISPLAY D-PROV LINE 13 COLUMN 15. DISPLAY D-POSTAL LINE 14 COLUMN 15. DISPLAY PRIMARY-USER-NAME LINE 10 COLUMN 28. DISPLAY STREET LINE 11 COLUMN 28. DISPLAY CITY LINE 12 COLUMN 28. DISPLAY PROVINCE LINE 13 COLUMN 28. DISPLAY POSTAL-CODE LINE 14 COLUMN 28. COPY "TIMEDATE.LIB". WRITE-REJECTED-CLIENT. MOVE "R" TO ACCOUNT-STATUS. REWRITE CLIENT-KEYS FROM CLIENT-READ-IN INVALID KEY DISPLAY "Write could not be performed" LINE 22 COLUMN 10. DISPLAY PRINTING-MESSAGE LINE 18 COLUMN 15. PERFORM PRINT-REJECTION-LETTER. MOVE 3 TO DELAY. CALL "LIB$WAIT" USING BY REFERENCE DELAY. COPY "REJECTED.LIB". TERMINATION. DISPLAY SPACES LINE 23 ERASE TO END OF LINE. DISPLAY "" LINE 23 COLUMN 30. ACCEPT EOF-FLAG LINE 23 COLUMN 58 PROTECTED. CLOSE CLIENT-FILE PRINTER. >> [?21h IDENTIFICATION DIVISION. PROGRAM-ID. UPDATE_CLIENT_FILE. AUTHOR. MIKE GALLANT. * This programs purpose is to write purchase made by client to * client file. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. ALPHA. OBJECT-COMPUTER. ALPHA. INPUT-OUTPUT SECTION. FILE-CONTROL. COPY "SELECT_CLIENT.LIB". DATA DIVISION. FILE SECTION. COPY "FD_CLIENT.LIB". WORKING-STORAGE SECTION. COPY "CLIENTREADIN.LIB". * To perform calculations on packed fields 01 OUTPUT-FIELDS. 05 O-CURRENT-BALANCE PIC 9(10). 05 O-ACTUAL-CRD-LIMIT PIC 9(10). 05 O-TOTAL-PURCHASES PIC 9(10). 05 O-LAST-PURCH-DATE PIC 9(08). 05 O-PURCHASE-AMT PIC 9(10). 01 SYS-DATE PIC X(08). 01 TEMP-STATUS PIC 9(08). 01 PROMPT PIC X. * Pass by reference from C++ program SALE.CXX LINKAGE SECTION. 01 PURCHASE-AMT PIC S9(11) COMP-3. 01 READ-ACCOUNT-ID PIC X(10). 01 ACCT-STATUS PIC S9(11) COMP-3. PROCEDURE DIVISION USING PURCHASE-AMT, READ-ACCOUNT-ID, ACCT-STATUS. MAINLINE. OPEN I-O CLIENT-FILE. PERFORM GET-ACCOUNT. CLOSE CLIENT-FILE. EXIT PROGRAM. GET-ACCOUNT. * Get Client record to write changes to MOVE READ-ACCOUNT-ID TO IDX-ACCOUNT-ID. READ CLIENT-FILE INTO CLIENT-READ-IN INVALID KEY DISPLAY "PROGRAM ERROR -- CONTACT SUPPORT" NOT INVALID KEY PERFORM UPDATE-CLIENT END-READ. UPDATE-CLIENT. * To change Account Status back to Active when it has been set to Inactive MOVE ACCT-STATUS TO TEMP-STATUS. IF TEMP-STATUS > 0 THEN MOVE "A" TO ACCOUNT-STATUS. * Move changed values to file output MOVE FUNCTION CURRENT-DATE TO SYS-DATE. MOVE CURRENT-BALANCE TO O-CURRENT-BALANCE. MOVE ACTUAL-CRD-LIMIT TO O-ACTUAL-CRD-LIMIT. MOVE TOTAL-PURCHASES TO O-TOTAL-PURCHASES. MOVE LAST-PURCH-DATE TO O-LAST-PURCH-DATE. MOVE PURCHASE-AMT TO O-PURCHASE-AMT. ADD O-PURCHASE-AMT TO O-CURRENT-BALANCE. SUBTRACT O-PURCHASE-AMT FROM O-ACTUAL-CRD-LIMIT. ADD O-PURCHASE-AMT TO O-TOTAL-PURCHASES. MOVE SYS-DATE TO O-LAST-PURCH-DATE. MOVE O-LAST-PURCH-DATE TO LAST-PURCH-DATE. MOVE O-ACTUAL-CRD-LIMIT TO ACTUAL-CRD-LIMIT. MOVE O-CURRENT-BALANCE TO CURRENT-BALANCE. MOVE O-TOTAL-PURCHASES TO TOTAL-PURCHASES. * ReWrite changed record REWRITE CLIENT-KEYS FROM CLIENT-READ-IN INVALID KEY DISPLAY "PROGRAM ERROR -- CONTACT SUPPORT". >> [?21h IDENTIFICATION DIVISION. PROGRAM-ID. UPDATE_CLIENT_RETURN. AUTHOR. MIKE GALLANT. * This programs purpose is to write return made by client to * client file. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. ALPHA. OBJECT-COMPUTER. ALPHA. INPUT-OUTPUT SECTION. FILE-CONTROL. COPY "SELECT_CLIENT.LIB". DATA DIVISION. FILE SECTION. COPY "FD_CLIENT.LIB". WORKING-STORAGE SECTION. COPY "CLIENTREADIN.LIB". 01 OUTPUT-FIELDS. 05 O-CURRENT-BALANCE PIC S9(11). 05 O-ACTUAL-CRD-LIMIT PIC 9(10). 05 O-TOTAL-PAYMENTS PIC S9(11). 05 O-TOTAL-PURCHASES PIC S9(11). 05 O-LAST-PURCH-DATE PIC 9(08). 05 O-RETURN-AMT PIC 9(10). 01 AMT-LEFT-OVER PIC S9(09). LINKAGE SECTION. 01 RETURN-AMT PIC S9(11) COMP-3. 01 READ-ACCOUNT-ID PIC X(10). 01 FUD-FLAG PIC X(03). PROCEDURE DIVISION USING RETURN-AMT, READ-ACCOUNT-ID, FUD-FLAG. MAINLINE. OPEN I-O CLIENT-FILE. PERFORM GET-ACCOUNT. CLOSE CLIENT-FILE. * To return to C++ program whether return was processed or whether it was cance lled IF AMT-LEFT-OVER < 0 THEN MOVE "NOO" TO FUD-FLAG ELSE MOVE "YES" TO FUD-FLAG. EXIT PROGRAM. GET-ACCOUNT. MOVE SPACES TO FUD-FLAG. MOVE READ-ACCOUNT-ID TO IDX-ACCOUNT-ID. READ CLIENT-FILE INTO CLIENT-READ-IN INVALID KEY DISPLAY "PROGRAM ERROR -- CONTACT SUPPORT" NOT INVALID KEY PERFORM UPDATE-CLIENT END-READ. UPDATE-CLIENT. MOVE CURRENT-BALANCE TO O-CURRENT-BALANCE. MOVE ACTUAL-CRD-LIMIT TO O-ACTUAL-CRD-LIMIT. MOVE TOTAL-PAYMENTS TO O-TOTAL-PAYMENTS. MOVE LAST-PURCH-DATE TO O-LAST-PURCH-DATE. MOVE RETURN-AMT TO O-RETURN-AMT. SUBTRACT O-RETURN-AMT FROM O-CURRENT-BALANCE. ADD O-RETURN-AMT TO O-ACTUAL-CRD-LIMIT. ADD O-RETURN-AMT TO O-TOTAL-PAYMENTS. MOVE O-ACTUAL-CRD-LIMIT TO ACTUAL-CRD-LIMIT. MOVE O-CURRENT-BALANCE TO CURRENT-BALANCE. MOVE O-TOTAL-PAYMENTS TO TOTAL-PAYMENTS. MOVE TOTAL-PURCHASES TO O-TOTAL-PURCHASES. SUBTRACT O-RETURN-AMT FROM O-TOTAL-PURCHASES GIVING AMT-LEFT-OVER. IF AMT-LEFT-OVER >= 0 THEN REWRITE CLIENT-KEYS FROM CLIENT-READ-IN INVALID KEY DISPLAY "PROGRAM ERROR -- CONTACT SUPPORT" END-IF. >> [?21h IDENTIFICATION DIVISION. PROGRAM-ID. UPDATE_CLIENT_PAYMENT. AUTHOR. MIKE GALLANT. * This programs purpose is to write payment made by client to * client file. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. ALPHA. OBJECT-COMPUTER. ALPHA. INPUT-OUTPUT SECTION. FILE-CONTROL. COPY "SELECT_CLIENT.LIB". DATA DIVISION. FILE SECTION. COPY "FD_CLIENT.LIB". WORKING-STORAGE SECTION. COPY "CLIENTREADIN.LIB". 01 OUTPUT-FIELDS. 05 O-CURRENT-BALANCE PIC S9(11). 05 O-ACTUAL-CRD-LIMIT PIC 9(10). 05 O-TOTAL-PAYMENTS PIC 9(10). 05 O-LAST-PAY-DATE PIC 9(08). 05 O-PAYMENT-AMT PIC 9(10). 05 O-MIN-PAY-DUE PIC S9(11). 01 SYS-DATE PIC X(08). LINKAGE SECTION. 01 PAYMENT-AMT PIC S9(11) COMP-3. 01 READ-ACCOUNT-ID PIC X(10). PROCEDURE DIVISION USING PAYMENT-AMT, READ-ACCOUNT-ID. MAINLINE. OPEN I-O CLIENT-FILE. PERFORM GET-ACCOUNT. CLOSE CLIENT-FILE. EXIT PROGRAM. GET-ACCOUNT. MOVE READ-ACCOUNT-ID TO IDX-ACCOUNT-ID. READ CLIENT-FILE INTO CLIENT-READ-IN INVALID KEY DISPLAY "PROGRAM ERROR -- CONTACT SUPPORT" NOT INVALID KEY PERFORM UPDATE-CLIENT END-READ. UPDATE-CLIENT. MOVE FUNCTION CURRENT-DATE TO SYS-DATE. MOVE CURRENT-BALANCE TO O-CURRENT-BALANCE. MOVE ACTUAL-CRD-LIMIT TO O-ACTUAL-CRD-LIMIT. MOVE TOTAL-PAYMENTS TO O-TOTAL-PAYMENTS. MOVE LAST-PAY-DATE TO O-LAST-PAY-DATE. MOVE PAYMENT-AMT TO O-PAYMENT-AMT. MOVE MIN-PAY-DUE TO O-MIN-PAY-DUE. SUBTRACT O-PAYMENT-AMT FROM O-CURRENT-BALANCE. SUBTRACT O-PAYMENT-AMT FROM O-MIN-PAY-DUE. * If minimum payment Due is negative, then make field equal to zero IF O-MIN-PAY-DUE < 1 THEN MOVE ZEROES TO O-MIN-PAY-DUE. ADD O-PAYMENT-AMT TO O-ACTUAL-CRD-LIMIT. ADD O-PAYMENT-AMT TO O-TOTAL-PAYMENTS. MOVE SYS-DATE TO O-LAST-PAY-DATE. MOVE O-LAST-PAY-DATE TO LAST-PAY-DATE. MOVE O-ACTUAL-CRD-LIMIT TO ACTUAL-CRD-LIMIT. MOVE O-CURRENT-BALANCE TO CURRENT-BALANCE. MOVE O-TOTAL-PAYMENTS TO TOTAL-PAYMENTS. MOVE O-MIN-PAY-DUE TO MIN-PAY-DUE. REWRITE CLIENT-KEYS FROM CLIENT-READ-IN INVALID KEY DISPLAY "PROGRAM ERROR -- CONTACT SUPPORT". >> [?21h // Accounts Receivable Register // By: Mike Gallant // Does a Accounts Receivable Register on all Accounts #include rms #include stdio #include ssdef #include starlet #include string #include stdlib #include ctype #include processes #include climsgdef #include perror #include math #include time #include #include #include #include "conio.h" #include "invalnum.h" #include "inputreq.h" #include "delay.h" extern void InitializeClientFile(); extern void OpenClient(); extern void CloseClient(); void ErrorExit(char *, char *); extern "C" void ar(char *, char &); void DoRegister(void); void PrintHeadings(int); // Prototypes for COBOL field conversion routines found in CONVPACK.OBJ extern void EnsureAllNumeric(char *); extern void AlignPIC9n(char *, long int, int, char); extern long int PIC9nToNumeric(char *, int, char); extern long int COMP3ToNumeric(char *, int); extern void NumericToCOMP3(char *, long int, int); #define CAnClientRecSize 256 #define CAnClientKeySize 44 struct FAB cClientFIL; struct RAB cClientREC; struct XABKEY cClientXABKEY0, cClientXABKEY1, cClientXABKEY2, cClientXABKEY3, cClientXABKEY4, cClientXABKEY5, cClientXABKEY6, cClientXABKEY7, cClientXABKEY8; struct CAcPrimary { char LastName[12], FirstName[18], MidInit[2]; }; struct CAcSecond { char LastName[12], FirstName[18], MidInit[2]; }; struct CAcAddress { char Street[18], City[18], Province[2], PostalCode[6]; }; struct CAnClient { char AccountId[10], AccountStatus[2]; int IssueDate, ExpiryDate, CardsIssued; struct CAcPrimary cPrimary; struct CAcSecond cSecond; int StatementDay; char PrevBalance[6], CurrentBalance[6], TotalPayments[6], TotalPurchases[6]; int LastPayDate, LastPurchDate; char MinPayDue[6], CreditLimit[6], ActualCrdLimit[6]; struct CAcAddress cAddress; char LangCode[2]; int LastContactDate; char WorkPhone[6], HomePhone[6], InterestOwed[6]; int DateOfBirth; char filler[42]; }; struct CAnClient cClient; static char *psFileName2 = "[comp97.gallantm]client.dat"; ofstream Register("[comp97.gallantm]AR.REG", ios::out); int RMSStatus; char ReportDate[8]; char Prompt; #include "loadclient.cxx" main() { /* External COBOL program to get Valid Date to report from and to serve as a Front-End screen */ ar(ReportDate, Prompt); /* Is operator did not cancel processing of report, do report */ if(Prompt != 'E') { Delay(2); InitializeClientFile(); OpenClient(); if(!Register) { cerr << "Seartons File could not be Opened (OUT)" << endl; exit(1); } DoRegister(); /* Function that produces AR Register */ Register.close(); CloseClient(); } gotoxy(31,15); cout << "Done! Hit Return:" << endl; cin.get(); return 0; } void DoRegister(void) { /* These fields are used to split up the account into two fields */ char fAccountId1[5], fAccountId2[7]; /* LinesDone is the Number of Lines printed on report to check for page bre ak */ /* PageNo is the Page Number that the report is currently printing */ int LinesDone, PageNo; /* 't' prefix means the running total for that field */ long int PrevBalance, InterestOwed, TotalPayments, TotalPurchases; long int ClosingBal, tPrevBalance, tInterestOwed, tTotalPayments; long int tTotalPurchases, tClosingBal; /* A 'd' prefix means that the field is a DOUBLE version of the given named variable. 'dt' means a DOUBLE total of the variable named */ double dPrevBalance, dInterestOwed, dTotalPayments, dTotalPurchases; double dClosingBal, dtPrevBalance, dtInterestOwed, dtTotalPayments; double dtTotalPurchases, dtClosingBal; /* Initialize Fields */ dtTotalPayments = 0; dtTotalPurchases = 0; dtClosingBal = 0; dtPrevBalance = 0; dtInterestOwed = 0; cClientREC.rab$b_krf = 0; // To Access the Branch Id Key RMSStatus = sys$rewind(&cClientREC); /* Move index pointer to beginning of file */ if(RMSStatus != RMS$_NORMAL) ErrorExit("$REWIND", cClientFIL.fab$l_fna); /* Read first record from file */ cClientREC.rab$b_rac = RAB$C_SEQ; cClientREC.rab$w_usz = CAnClientRecSize; cClientREC.rab$l_ubf = (char *) &cClient; RMSStatus = sys$get(&cClientREC); // if(RMSStatus == RMS$_EOF) break; if (RMSStatus != RMS$_NORMAL) ErrorExit("$GET", cClientFIL.fab$l_fna); PageNo = 1; LinesDone = 0; PrintHeadings(PageNo); while(RMSStatus != RMS$_EOF) { strncpy(fAccountId1,cClient.AccountId,4); strncpy(fAccountId2,&(cClient.AccountId[4]),6); fAccountId1[4] = '\0'; fAccountId2[6] = '\0'; LinesDone++; if(LinesDone >= 40) { PageNo++; Register << "----------------------------------------------------"; PrintHeadings(PageNo); LinesDone = 1; } PrevBalance = COMP3ToNumeric(&cClient.PrevBalance[0],6); dPrevBalance = (double)(PrevBalance); TotalPayments = COMP3ToNumeric(&cClient.TotalPayments[0],6); dTotalPayments = (double)(TotalPayments); TotalPurchases = COMP3ToNumeric(&cClient.TotalPurchases[0],6); dTotalPurchases = (double)(TotalPurchases); InterestOwed = COMP3ToNumeric(&cClient.InterestOwed[0],6); dInterestOwed = (double)(InterestOwed); ClosingBal = (PrevBalance + TotalPurchases - TotalPayments + InterestOwe d); dClosingBal = (double)(ClosingBal); Register << " " << fAccountId1 << "-" << fAccountId2 << " " << setiosflags(ios::fixed | ios::showpoint) << setw(11) << setprecision( 2) << ((dPrevBalance / 100) + 0.004) << " " << setw(11) << setprecision(2 ) << ((dTotalPurchases / 100) + 0.004) << " " << setw(11) << setprecision (2) << ((dTotalPayments / 100) + 0.004) << " " << setw(11) << setprecision( 2) << ((dInterestOwed / 100) + 0.004) << " " << setw(15) << setprecision( 2) << ((dClosingBal / 100) + 0.004) << endl; dtClosingBal += dClosingBal; dtPrevBalance += dPrevBalance; dtTotalPayments += dTotalPayments; dtTotalPurchases += dTotalPurchases; dtInterestOwed += dInterestOwed; RMSStatus = sys$get(&cClientREC); if(RMSStatus == RMS$_EOF) break; else if (RMSStatus != RMS$_NORMAL) ErrorExit("$GET", cClientFIL.fab$l_fna); } Register << "\n" << " TOTALS" << '\n'; Register << " OPENING BALANCE : " << setw(14) << setprecision(2) << ((dtPrevBalance / 100) + 0.004) << '\n'; Register << " PURCHASES : " << setw(14) << setprecision(2) << ((dtTotalPurchases / 100) + 0.004) << '\n'; Register << " PAYMENTS : " << setw(14) << setprecision(2) << ((dtTotalPayments / 100) + 0.004) << '\n'; Register << " CREDIT CHARGES : " << setw(14) << setprecision(2) << ((dtInterestOwed / 100) + 0.004) << '\n'; Register << " CLOSING BALANCE : " << setw(14) << setprecision(2) << ((dtClosingBal / 100) + 0.004) << '\n'; } void PrintHeadings(int PageNo) { char RepDate[11]; /* To store date in Format 9999-99-99 */ /* Code that moves the Report Date into the field given above this line */ strncpy(RepDate,ReportDate,4); strncpy(&(RepDate[5]),&(ReportDate[4]),2); strncpy(&(RepDate[8]),&(ReportDate[6]),2); RepDate[4] = '-'; RepDate[7] = '-'; RepDate[10] = '\0'; /* Print Heading Information */ Register << '\f' << setw(54) << "SEARTONS CHARGE CARD SYSTEM" << "\n\n" << setw(55) << "ACCOUNTS RECEIVABLE REGISTER" << "\n"; Register << setw(55) << "----------------------------" << "\n\n"; Register << " Date: " << RepDate << setw(60) << "Page: " << PageNo << "\n\n"; Register << " ACCOUNT ID OPENING BAL + PURCHASES - PAYMENTS" << " + CR. CHARGES = CLOSING BALANCE" << '\n'; Register << "------------------------------------------------------" << "------------------------------------" << '\n'; } /* Used to Display RMS Error Messages */ void ErrorExit(char *psOperation, char *psFileName) { printf("RMSEXP2 - file %s failed (%s)\n", psFileName, psOperation); exit(RMSStatus); } >> [?21h /* COBOL Field Conversion Routines. */ /* J.E. Marriott / NBCC-SJ / Mar.92 */ #include ctype #include string #include "convpack.h" void EnsureAllNumeric(char *); void AlignPIC9n(char *, long int, int, char); long int PIC9nToNumeric(char *, int, char); long int COMP3ToNumeric(char *, int); void NumericToCOMP3(char *, long int, int); extern void ErrorExit(char *, char *); void EnsureAllNumeric(char *string_io) { int i=0; char byte; while ( byte = *(string_io+(i++))){ if ( isdigit(byte) || byte == '.' || byte == '+' || byte == '-' ); else { *string_io = '\0'; break; } } } void AlignPIC9n(char *string_io, long int number_in, int nbr_of_bytes, char field_type) { /* */ /* This routine aligns PIC 9(n) & S9(n) fields properly. */ /* It also creates the "overpunched" last digit for an S9(n) field. */ /* */ int i, negative=0; if (field_type != 'U' && field_type != 'S') ErrorExit("Invalid Field Type Specified.","AlignPIC9n"); if (field_type == 'U' && number_in < 0) ErrorExit("Invalid Negative","AlignPIC9n"); if (number_in < 0) { negative = 1; number_in *= -1; } for (i=nbr_of_bytes-1; i>=0; i--) { if (i == nbr_of_bytes-1) { if (field_type == 'U') *(string_io+i) = ascii_digit[number_in % 10]; else if (negative) *(string_io+i) = overpunch[(number_in % 10) + 10]; else *(string_io+i) = overpunch[number_in % 10]; } else *(string_io+i) = ascii_digit[number_in % 10]; number_in /= 10; } } long int PIC9nToNumeric(char *string_in, int nbr_of_bytes, char field_type) { /* This routine returns the numeric equivalent of a PIC 9(n) field. */ /* It also "unpacks" the last overpunched byte of a PIC S9(n) field */ /* and returns the resulting number. */ /* */ int i, sign = 1, digit_not_found = 1; long int number_out; char photo[20]; if (field_type != 'U' && field_type != 'S') ErrorExit("Invalid Field Type Specified.","PIC9nToNumeric"); /* Take a copy so that we can mess with the last character */ for (i=0 ; i < nbr_of_bytes ; i++) photo[i] = *(string_in+i); photo[nbr_of_bytes] = '\0'; if (field_type == 'S') for (i=0 ; i<20 ; i++) { if (photo[nbr_of_bytes - 1] == overpunch[i]) { digit_not_found = 0; if (i > 9) { sign = -1; photo[nbr_of_bytes - 1] = ascii_digit[i-10]; } elsephoto[nbr_of_bytes - 1] = ascii_digit[i]; break; } } if (field_type == 'S' && digit_not_found) ErrorExit("PIC S9(n) Conversion","PIC9nToNumeric"); number_out = atol(photo) * sign; return number_out; } long int COMP3ToNumeric(char *string_in, int nbr_of_bytes) { /* */ /* This routine can unpack up to 6 bytes with */ /* Numeric Range -2,147,483,648 to 2,147,483,647 */ /* */ int i, j, digit_not_found; int multiple; long int number_out = 0; char photo[6], sign_byte; if (nbr_of_bytes < 2 || nbr_of_bytes > 6) ErrorExit("Invalid #Bytes","COMP3ToNumeric"); /* Take a copy so that we can mess with the last character */ for (i=0 ; i < nbr_of_bytes ; i++) photo[i] = *(string_in+i); /* Isolate the sign mask */ sign_byte = photo[nbr_of_bytes-1] << 4; /* Strip out the sign from the low-end nibble */ photo[nbr_of_bytes-1] = photo[nbr_of_bytes-1] >> 4; /* An 8 or 9 will drag '1's across, so '&' them out! */ photo[nbr_of_bytes-1] = photo[nbr_of_bytes-1] & 0x0F; for (i=0, multiple=100 ; i < nbr_of_bytes ; i++) { digit_not_found = 1; if (i == nbr_of_bytes - 1) multiple = 10; for (j=0 ; j<100 ; j++) { if (photo[i] == comp3_byte_mask[j]) { number_out = number_out * multiple + j; digit_not_found = 0; break; } } if (digit_not_found) ErrorExit("Digit not found in conversion","COMP3ToNumeric"); } if (sign_byte == packed_sign[0] || sign_byte == packed_sign[2] || sign_byte == packed_sign[4] || sign_byte == packed_sign[5] ) number_out *= 1; else { if (sign_byte == packed_sign[1] || sign_byte == packed_sign[3] ) number_out *= -1; else ErrorExit("Sign Interpretation", "COMP3ToNumeric"); } return number_out; } void NumericToCOMP3(char *string_out, long int number_in, int nbr_of_bytes){ /* */ /* This routine can pack up to 6 bytes with */ /* Numeric Range -2,147,483,648 to 2,147,483,647 */ /* */ int i; if (nbr_of_bytes < 2 || nbr_of_bytes > 6) ErrorExit("Invalid #Bytes","numeric_to_comp3"); if (number_in < 0) { number_in *= -1; *(string_out+nbr_of_bytes-1) = neg_comp3_sign_byte[number_in%10]; } else *(string_out+nbr_of_bytes-1) = pos_comp3_sign_byte[number_in%10]; number_in /= 10; for (i=nbr_of_bytes-2 ; i>=0 ; i--) { *(string_out+i) = comp3_byte_mask[number_in % 100]; number_in /= 100; } } >> [?21h // Daily Payments Register // By: Mike Gallant // Does a Daily Payments Register for Payments #include rms #include stdio #include ssdef #include starlet #include string #include stdlib #include ctype #include processes #include climsgdef #include perror #include math #include time #include #include #include #include "conio.h" #include "invalnum.h" #include "inputreq.h" #include "delay.h" extern void InitializePaymentFile(); extern void OpenPayment(); extern void ClosePayment(); void PadPaymentRecord(); void Pad(char *, int); void DisplayString(char *, int); void ErrorExit(char *, char *); extern "C" void daily_payments(char *, char &); void DoRegister(void); void DoBranchBreak(int, double); void PageBreak(char *, char *, int); void EndBreak(double); void SetNewBranch(char *); void GetFirstMatch(void); // Prototypes for COBOL field conversion routines found in CONVPACK.OBJ extern void EnsureAllNumeric(char *); extern void AlignPIC9n(char *, long int, int, char); extern long int PIC9nToNumeric(char *, int, char); extern long int COMP3ToNumeric(char *, int); extern void NumericToCOMP3(char *, long int, int); #define CAnPaymentRecSize 256 #define CAnPaymentKeySize 24 struct FAB cPaymentFIL; struct RAB cPaymentREC; struct XABKEY cPaymentXABKEY0, cPaymentXABKEY1, cPaymentXABKEY2; struct CAnPaymentKey { char AccountId[10], PaymentDate[8], PaymentTime[6]; }; struct CAnPayment { struct CAnPaymentKey cPaymentKey; char BranchId[4], PaymentType[2], ReferenceId[4], BranchProv[2], PaymentAmt[6], PaymentFiller[214]; }; struct CAnPayment cPayment; static char *psFileName = "[comp97.gallantm]payment-transaction.dat"; /* Open Payment Register file Globally to allow easier processing */ ofstream Register("[comp97.gallantm]DAILY-PAYMENT.REG", ios::out); int RMSStatus; /* Used with RMS to display error messages */ char ReportDate[8]; /* Date to produce report for returned from COBOL program * / char Prompt; /* Operator input to indicate if report is to be produced o r cancelled */ /* Functions used by RMS to PAD files with Spaces and Display Error Messages */ #include "loadpayment.cxx" /* RMS Function to Initialize Payment File, Open and Close it */ #include "rmsfunc2.cxx" main() { daily_payments(ReportDate, Prompt); /* COBOL function to get ReportDate for register */ /* If operator did not cancel printing of report, produce it */ if(Prompt != 'E') { Delay(3); InitializePaymentFile(); OpenPayment(); if(!Register) { cerr << "Register File could not be Opened (OUT)" << endl; exit(1); } DoRegister(); Register.close(); ClosePayment(); } gotoxy(31,15); cout << "Done! Hit Return:" << endl; cin.get(); return 0; } // This function produces the Daily Payments Register void DoRegister(void) { char BranchBreak[4]; /* Branch Id stored in Payments File, used to check f or a branch break */ int Entries, /* Number of transactions printed for current branch */ LinesDone, /* Current line number on screen, Used for Page Break */ PageNo; /* Current page number of register */ long int AmtPayment; /* Amount paid for current transaction */ double TotalPayment, /* Floating point version of AmtPayment for output to register */ dAmtPayment, /* Branch total of all payments */ dGrandTotalPayment; /* Grand total of all payments printed */ char fBranchId[5], /* Branch Id of current transaction with a NULL at t he end so that it can be printed to a report */ fAccountId[12], /* Account Id of current transaction with a NULL at the end so that it can be printed to report */ fPaymentDate[9]; /* Date that payment was made with a NULL at the end so that this field can be printed to report */ cPaymentREC.rab$b_krf = 1; // To Access the Branch Id Key RMSStatus = sys$rewind(&cPaymentREC); if(RMSStatus != RMS$_NORMAL) ErrorExit("$REWIND", cPaymentFIL.fab$l_fna); cPaymentREC.rab$b_rac = RAB$C_SEQ; cPaymentREC.rab$w_usz = CAnPaymentRecSize; cPaymentREC.rab$l_ubf = (char *) &cPayment; RMSStatus = sys$get(&cPaymentREC); // if(RMSStatus == RMS$_EOF) break; if (RMSStatus != RMS$_NORMAL) ErrorExit("$GET", cPaymentFIL.fab$l_fna); PageNo = 1; LinesDone = 0; PageBreak(cPayment.BranchId, ReportDate, PageNo); GetFirstMatch(); strncpy(fBranchId, cPayment.BranchId, 4); fBranchId[4] = '\0'; strncpy(BranchBreak, cPayment.BranchId, 4); Entries = 0; TotalPayment = 0; do { if(strncmp(cPayment.BranchId, BranchBreak, 4) && Entries != 0) { LinesDone += 6; if(LinesDone >= 45) { PageNo++; PageBreak(cPayment.BranchId, ReportDate, PageNo); LinesDone = 0; } DoBranchBreak(Entries, TotalPayment); dGrandTotalPayment += TotalPayment; Entries = 0; TotalPayment = 0; GetFirstMatch(); } if(RMSStatus == RMS$_EOF) break; strncpy(BranchBreak, cPayment.BranchId, 4); if(!(strncmp(cPayment.cPaymentKey.PaymentDate, ReportDate, 8))) { LinesDone++; Entries++; /* If there was a least one transaction printed for current branch, then print Branch Break */ if(Entries == 1) { LinesDone += 4; if(LinesDone >= 45) { PageNo++; PageBreak(cPayment.BranchId, ReportDate, PageNo); LinesDone = 0; } SetNewBranch(cPayment.BranchId); } Register << " " << setw(4) << Entries; /* Output Account Id to Register */ strncpy(fAccountId,cPayment.cPaymentKey.AccountId, 4); fAccountId[4] = '-'; strncpy(&fAccountId[5], &cPayment.cPaymentKey.AccountId[4], 6); fAccountId[11] = '\0'; Register << setw(16) << &fAccountId[0]; /* Output Payment Amount to Register */ AmtPayment = COMP3ToNumeric(&cPayment.PaymentAmt[0],6); dAmtPayment = (double)(AmtPayment); TotalPayment += (dAmtPayment / 100); Register << setiosflags(ios::fixed | ios::showpoint) << setw(20) << setprecision(2) << "$" << (dAmtPayment / 100) << '\n'; if(LinesDone >= 45) { PageNo++; PageBreak(cPayment.BranchId, ReportDate, PageNo); LinesDone = 0; } } /* Get next record */ RMSStatus = sys$get(&cPaymentREC); /* Check for End-Of-File */ if(RMSStatus == RMS$_EOF) break; else if (RMSStatus != RMS$_NORMAL) ErrorExit("$GET", cPaymentFIL.fab$l_fna); } while(RMSStatus != RMS$_EOF); LinesDone += 8; if(LinesDone >= 45) { PageNo++; PageBreak(cPayment.BranchId, ReportDate, PageNo); LinesDone = 0; } /* If there was a least one entry for last branch, print Branch Break */ if(Entries != 0) { Register << " -----------------------------------------------"; Register << '\n'; Register << setw(14) << Entries << setw(36) << "$" << TotalPayment; Register << "\n\n Branch Entries : " << Entries << "\n\n"; Register << " Branch Amount of Payment : " << "$" << TotalPayment ; Register << "\n"; dGrandTotalPayment += TotalPayment; Entries = 0; TotalPayment = 0; } EndBreak(dGrandTotalPayment); } void GetFirstMatch(void) { while((strncmp(cPayment.cPaymentKey.PaymentDate, ReportDate, 8)) && RMSStatu s != RMS$_EOF ) { RMSStatus = sys$get(&cPaymentREC); if(RMSStatus == RMS$_EOF) break; else if (RMSStatus != RMS$_NORMAL) ErrorExit("$GET", cPaymentFIL.fab$l_fna); } } void DoBranchBreak(int Entries, double TotalPayment) { Register << " -----------------------------------------------"; Register << '\n'; Register << setw(14) << Entries << setw(36) << "$" << TotalPayment; Register << "\n\n Branch Entries : " << Entries << "\n\n"; Register << " Branch Amount of Payment : " << "$" << TotalPayment; Register << "\n"; } void SetNewBranch(char BranchId[]) { char fBranchId[5]; Register << "\n\n" << " Branch #: "; strncpy(fBranchId, BranchId, 4); fBranchId[4] = '\0'; Register << &fBranchId[0] << "\n\n"; Register << " ENTRY# ACCOUNT ID # AMOUNT PURCHASED"; Register << '\n'; } void PageBreak(char BranchId[], char ReportDate[], int PageNo) { char fBranchId[5], fReportDate[11]; Register << '\f' << setw(54) << "SEARTONS CREDIT CARD SYSTEM" << "\n" << setw(54) << "DAILY PAYMENTS REGISTER" << "\n\n\n"; strncpy(fReportDate, ReportDate, 4); fReportDate[4] = '/'; strncpy(&fReportDate[5], &ReportDate[4], 2); fReportDate[7] = '/'; strncpy(&fReportDate[8], &ReportDate[6], 2); fReportDate[10] = '\0'; Register << " DATE: " << &fReportDate[0] << " " << " " << " " << "PAGE: " << PageNo << "\n\n"; Register << '\n'; } void EndBreak(double GrandTotal) { Register << '\n' << " Total Amount of Payment : $" << GrandTotal; } >> [?21h // Daily Returns Register // By: Mike Gallant // Does a Daily Returns Register for Returns #include rms #include stdio #include ssdef #include starlet #include string #include stdlib #include ctype #include processes #include climsgdef #include perror #include math #include time #include #include #include #include "conio.h" #include "invalnum.h" #include "inputreq.h" #include "delay.h" extern void InitializeReturnFile(); extern void OpenReturn(); extern void CloseReturn(); void PadReturnRecord(); void Pad(char *, int); void DisplayString(char *, int); void ErrorExit(char *, char *); extern "C" void daily_returns(char *, char &); void DoRegister(void); void DoBranchBreak(int, double); void PageBreak(char *, char *, int); void EndBreak(double); void SetNewBranch(char *); void GetFirstMatch(void); // Prototypes for COBOL field conversion routines found in CONVPACK.OBJ extern void EnsureAllNumeric(char *); extern void AlignPIC9n(char *, long int, int, char); extern long int PIC9nToNumeric(char *, int, char); extern long int COMP3ToNumeric(char *, int); extern void NumericToCOMP3(char *, long int, int); #define CAnReturnRecSize 256 #define CAnReturnKeySize 24 struct FAB cReturnFIL; struct RAB cReturnREC; struct XABKEY cReturnXABKEY0, cReturnXABKEY1, cReturnXABKEY2; struct CAnReturnKey { char AccountId[10], ReturnDate[8], ReturnTime[6]; }; struct CAnReturn { struct CAnReturnKey cReturnKey; char BranchId[4]; int ReturnNbr; char ReturnAmt[6], filler[222]; }; struct CAnReturn cReturn; static char *psFileName = "[comp97.gallantm]returns.dat"; /* Open Returns register file globally to allow easier processing */ ofstream Register("[comp97.gallantm]DAILY-RETURN.REG", ios::out); int RMSStatus; /* Used with RMS to display error messages */ char ReportDate[8]; /* Date to produce report returned from COBOL program */ char Prompt; /* Operator to input to indicate if report is to be produce d or cancelled */ /* Functions used by RMS to PAD files with spaces and display error messages */ #include "loadreturn.cxx" /* RMS functions to Initialize Return file, Open and Close it */ #include "rmsfunc3.cxx" main() { daily_returns(ReportDate, Prompt); /* COBOL function to get ReportDate for register */ /* If operator did not cancel printing of report, then produce it */ if(Prompt != 'E') { Delay(3); InitializeReturnFile(); OpenReturn(); if(!Register) { cerr << "Seartons File could not be Opened (OUT)" << endl; exit(1); } DoRegister(); Register.close(); CloseReturn(); } gotoxy(25,15); cout << "Done! Hit Return:" << endl; cin.get(); return 0; } // This function produces the Daily Returns register void DoRegister(void) { char BranchBreak[4]; /* Branch Id stored in Returns file, used to check for a branch break */ int Entries, /* Number of transactions printed for current branch */ LinesDone, /* Current line number on screen, Used for Page Break */ PageNo; /* Current Page number of register */ long int AmtReturn; /* Amount returned for current transaction */ double TotalReturn, /* Floating point version of AmtReturn for output to r egister */ dAmtReturn, /* Branch Total of all Returns */ dGrandTotalReturn; /* Grand total of all Returns printed */ char fBranchId[5], /* Branch Id of current transaction with a NULL at the end so that it can be printed to the register */ fAccountId[12], /* Account Id of current transaction with a NULL at th e end so that it can be printed to the register */ fReturnDate[9]; /* Date the return as made with a NULL at the end so t hat this field can be output to the returns register */ cReturnREC.rab$b_krf = 1; // To Access the Branch Id Key RMSStatus = sys$rewind(&cReturnREC); if(RMSStatus != RMS$_NORMAL) ErrorExit("$REWIND", cReturnFIL.fab$l_fna); cReturnREC.rab$b_rac = RAB$C_SEQ; cReturnREC.rab$w_usz = CAnReturnRecSize; cReturnREC.rab$l_ubf = (char *) &cReturn; RMSStatus = sys$get(&cReturnREC); // if(RMSStatus == RMS$_EOF) break; if (RMSStatus != RMS$_NORMAL) ErrorExit("$GET", cReturnFIL.fab$l_fna); PageNo = 1; LinesDone = 0; PageBreak(cReturn.BranchId, ReportDate, PageNo); GetFirstMatch(); strncpy(fBranchId, cReturn.BranchId, 4); fBranchId[4] = '\0'; strncpy(BranchBreak, cReturn.BranchId, 4); Entries = 0; TotalReturn = 0; do { if(strncmp(cReturn.BranchId, BranchBreak, 4) && Entries != 0) { LinesDone += 6; if(LinesDone >= 45) { PageNo++; PageBreak(cReturn.BranchId, ReportDate, PageNo); LinesDone = 0; } DoBranchBreak(Entries, TotalReturn); dGrandTotalReturn += TotalReturn; Entries = 0; TotalReturn = 0; GetFirstMatch(); } if(RMSStatus == RMS$_EOF) break; strncpy(BranchBreak, cReturn.BranchId, 4); if(!(strncmp(cReturn.cReturnKey.ReturnDate, ReportDate, 8))) { LinesDone++; Entries++; /* If there was a least one transaction printed for current branch, then do branch break */ if(Entries == 1) { LinesDone += 6; if(LinesDone >= 45) { PageNo++; PageBreak(cReturn.BranchId, ReportDate, PageNo); LinesDone = 0; } SetNewBranch(cReturn.BranchId); } Register << " " << setw(4) << Entries; /* Output Account Id to register */ strncpy(fAccountId,cReturn.cReturnKey.AccountId, 4); fAccountId[4] = '-'; strncpy(&fAccountId[5], &cReturn.cReturnKey.AccountId[4], 6); fAccountId[11] = '\0'; Register << setw(16) << &fAccountId[0]; /* Output Return Amount to register */ AmtReturn = COMP3ToNumeric(&cReturn.ReturnAmt[0],6); dAmtReturn = (double)(AmtReturn); TotalReturn += (dAmtReturn / 100); Register << setiosflags(ios::fixed | ios::showpoint) << setw(20) << setprecision(2) << "$" << (dAmtReturn / 100) << '\n'; if(LinesDone >= 45) { PageNo++; PageBreak(cReturn.BranchId, ReportDate, PageNo); LinesDone = 0; } } /* Get next record */ RMSStatus = sys$get(&cReturnREC); /* Check for End-Of-File */ if(RMSStatus == RMS$_EOF) break; else if (RMSStatus != RMS$_NORMAL) ErrorExit("$GET", cReturnFIL.fab$l_fna); } while(RMSStatus != RMS$_EOF); LinesDone += 8; if(LinesDone >= 45) { PageNo++; PageBreak(cReturn.BranchId, ReportDate, PageNo); LinesDone = 0; } /* If there was a least one transaction printed for last branch, do branch break */ if(Entries != 0) { Register << " -----------------------------------------------"; Register << '\n'; Register << setw(14) << Entries << setw(36) << "$" << TotalReturn; Register << "\n\n Branch Entries : " << Entries << "\n\n"; Register << " Branch Amount of Return : " << "$" << TotalReturn; Register << "\n"; dGrandTotalReturn += TotalReturn; Entries = 0; TotalReturn = 0; } EndBreak(dGrandTotalReturn); } void GetFirstMatch(void) { while((strncmp(cReturn.cReturnKey.ReturnDate, ReportDate, 8)) && RMSStatus ! = RMS$_EOF ) { RMSStatus = sys$get(&cReturnREC); if(RMSStatus == RMS$_EOF) break; else if (RMSStatus != RMS$_NORMAL) ErrorExit("$GET", cReturnFIL.fab$l_fna); } } void DoBranchBreak(int Entries, double TotalReturn) { Register << " -----------------------------------------------"; Register << '\n'; Register << setw(14) << Entries << setw(36) << "$" << TotalReturn; Register << "\n\n Branch Entries : " << Entries << "\n\n"; Register << " Branch Amount of Return : " << "$" << TotalReturn; Register << "\n"; } void SetNewBranch(char BranchId[]) { char fBranchId[5]; Register << "\n\n" << " Branch #: "; strncpy(fBranchId, BranchId, 4); fBranchId[4] = '\0'; Register << &fBranchId[0] << "\n\n"; Register << " ENTRY# ACCOUNT ID # AMOUNT PURCHASED"; Register << '\n'; } void PageBreak(char BranchId[], char ReportDate[], int PageNo) { char fBranchId[5], fReportDate[11]; Register << '\f' << setw(54) << "SEARTONS CREDIT CARD SYSTEM" << "\n" << setw(51) << "DAILY RETURNS REGISTER" << "\n\n\n"; strncpy(fReportDate, ReportDate, 4); fReportDate[4] = '/'; strncpy(&fReportDate[5], &ReportDate[4], 2); fReportDate[7] = '/'; strncpy(&fReportDate[8], &ReportDate[6], 2); fReportDate[10] = '\0'; Register << " DATE: " << &fReportDate[0] << " " << " " << " " << "PAGE: " << PageNo << "\n\n"; Register << '\n'; } void EndBreak(double GrandTotal) { Register << '\n' << " Total Amount of Return : $" << GrandTotal; } >> [?21h // Daily Sales Register // By: Mike Gallant // Does a Daily Sales Register for Sales #include rms #include stdio #include ssdef #include starlet #include string #include stdlib #include ctype #include processes #include climsgdef #include perror #include math #include time #include #include #include #include "conio.h" #include "invalnum.h" #include "inputreq.h" #include "delay.h" extern void InitializeSalesFile(); extern void OpenSales(); extern void CloseSales(); void PadSalesRecord(); void Pad(char *, int); void DisplayString(char *, int); void ErrorExit(char *, char *); extern "C" void daily_sales(char *, char &); void DoRegister(void); void DoBranchBreak(int, double); void PageBreak(char *, char *, int); void EndBreak(double); void GetFirstMatch(void); void SetNewBranch(char *); // Prototypes for COBOL field conversion routines found in CONVPACK.OBJ extern void EnsureAllNumeric(char *); extern void AlignPIC9n(char *, long int, int, char); extern long int PIC9nToNumeric(char *, int, char); extern long int COMP3ToNumeric(char *, int); extern void NumericToCOMP3(char *, long int, int); #define CAnSalesRecSize 256 #define CAnSalesKeySize 24 struct FAB cSalesFIL; struct RAB cSalesREC; struct XABKEY cSalesXABKEY0, cSalesXABKEY1; struct CAnSalesKey { char AccountId[10]; char SaleDate[8]; char SaleTime[6]; }; struct CAnSales { struct CAnSalesKey cSalesKey; char BranchId[4]; int SalesSlipNbr; int AuthNbr; char PurchaseAmt[6]; char filler[214]; }; struct CAnSales cSales; static char *psFileName = "[comp97.gallantm]sales-transaction.dat"; /* Open Sales Register globally to allow easier processing */ ofstream Register("[comp97.gallantm]DAILY-SALES.REG", ios::out); int RMSStatus; /* Used with RMS to display error messages */ char ReportDate[8]; /* Date to produce report returned from COBOL program */ char Prompt; /* Operator input to indicate if report is to be produced o r cancelled */ /* Functions used by RMS to PAD files with Spaces and Display Error Messages */ #include "loadsale.cxx" /* RMS functions to Initialize Sales File, Open and Close it */ #include "rmsfunc.cxx" main() { daily_sales(ReportDate, Prompt); /* COBOL function to get report date for r egister */ /* If operator did not cancel printing of report, produce it */ if(Prompt != 'E') { Delay(2); InitializeSalesFile(); OpenSales(); if(!Register) { cerr << "Seartons File could not be Opened (OUT)" << endl; exit(1); } DoRegister(); Register.close(); CloseSales(); } gotoxy(31,15); cout << "Done! Hit Return:" << endl; cin.get(); return 0; } void DoRegister(void) { char BranchBreak[4]; /* Branch Id stored in Sales file, used to check for a branch break */ int Entries, /* Number of transaction printed for current branch */ LinesDone, /* Current line number on screen, Used for page break */ PageNo; /* Current page number of register */ long int AmtPurchased; /* Amount paid for current transaction */ double TotalSales, /* Floating point version of AmtPurchased for output to register */ dAmtPurchased, /* Branch total of all payments */ dGrandTotalSales; /* Grand total of all payment printed */ char fBranchId[5], /* Branch Id of current transaction with a NULL at t he end so that it can be printed to a report */ fAccountId[12], /* Account Id of current transaction with a NULL at the end so that it can be printed to report */ fPaymentDate[9]; /* Date that payment was made with a NULL at the end so that this field can be printed to report */ cSalesREC.rab$b_krf = 1; // To Access the Branch Id Key RMSStatus = sys$rewind(&cSalesREC); if(RMSStatus != RMS$_NORMAL) ErrorExit("$REWIND", cSalesFIL.fab$l_fna); cSalesREC.rab$b_rac = RAB$C_SEQ; cSalesREC.rab$w_usz = CAnSalesRecSize; cSalesREC.rab$l_ubf = (char *) &cSales; RMSStatus = sys$get(&cSalesREC); // if(RMSStatus == RMS$_EOF) break; if (RMSStatus != RMS$_NORMAL) ErrorExit("$GET", cSalesFIL.fab$l_fna); PageNo = 1; LinesDone = 0; PageBreak(cSales.BranchId, ReportDate, PageNo); GetFirstMatch(); strncpy(fBranchId, cSales.BranchId, 4); fBranchId[4] = '\0'; strncpy(BranchBreak, cSales.BranchId, 4); Entries = 0; TotalSales = 0; do { if(strncmp(cSales.BranchId, BranchBreak, 4) && Entries != 0) { LinesDone += 6; if(LinesDone >= 45) { PageNo++; PageBreak(cSales.BranchId, ReportDate, PageNo); LinesDone = 0; } DoBranchBreak(Entries, TotalSales); dGrandTotalSales += TotalSales; Entries = 0; TotalSales = 0; GetFirstMatch(); } if(RMSStatus == RMS$_EOF) break; strncpy(BranchBreak, cSales.BranchId, 4); if(!(strncmp(cSales.cSalesKey.SaleDate, ReportDate, 8))) { LinesDone++; Entries++; /* If there was a least one transaction printed for current branch, then print Branch Break */ if(Entries == 1) { LinesDone += 6; if(LinesDone >= 45) { PageNo++; PageBreak(cSales.BranchId, ReportDate, PageNo); LinesDone = 0; } SetNewBranch(cSales.BranchId); } Register << " " << setw(4) << Entries; /* Output Account Id to register */ strncpy(fAccountId,cSales.cSalesKey.AccountId, 4); fAccountId[4] = '-'; strncpy(&fAccountId[5], &cSales.cSalesKey.AccountId[4], 6); fAccountId[11] = '\0'; Register << setw(16) << &fAccountId[0]; /* Output Purchase Amount to Register */ AmtPurchased = COMP3ToNumeric(&cSales.PurchaseAmt[0],6); dAmtPurchased = (double)(AmtPurchased); TotalSales += (dAmtPurchased / 100); Register << setiosflags(ios::fixed | ios::showpoint) << setw(20) << setprecision(2) << "$" << (dAmtPurchased / 100) << '\n'; if(LinesDone >= 45) { PageNo++; PageBreak(cSales.BranchId, ReportDate, PageNo); LinesDone = 0; } } /* GEt next record */ RMSStatus = sys$get(&cSalesREC); /* Check for End-Of-File */ if(RMSStatus == RMS$_EOF) break; else if (RMSStatus != RMS$_NORMAL) ErrorExit("$GET", cSalesFIL.fab$l_fna); } while(RMSStatus != RMS$_EOF); LinesDone += 8; if(LinesDone >= 45) { PageNo++; PageBreak(cSales.BranchId, ReportDate, PageNo); LinesDone = 0; } /* If there was at least one entry for last branch, then print branch break */ if(Entries != 0) { Register << " -----------------------------------------------"; Register << '\n'; Register << setw(14) << Entries << setw(36) << "$" << TotalSales; Register << "\n\n Branch Entries : " << Entries << "\n\n"; Register << " Branch Amount of Sales : " << "$" << TotalSales; Register << "\n"; dGrandTotalSales += TotalSales; Entries = 0; TotalSales = 0; } EndBreak(dGrandTotalSales); } void GetFirstMatch(void) { while((strncmp(cSales.cSalesKey.SaleDate, ReportDate, 8)) && RMSStatus != RM S$_EOF ) { RMSStatus = sys$get(&cSalesREC); if(RMSStatus == RMS$_EOF) break; else if (RMSStatus != RMS$_NORMAL) ErrorExit("$GET", cSalesFIL.fab$l_fna); } } void DoBranchBreak(int Entries, double TotalSales) { Register << " -----------------------------------------------"; Register << '\n'; Register << setw(14) << Entries << setw(36) << "$" << TotalSales; Register << "\n\n Branch Entries : " << Entries << "\n\n"; Register << " Branch Amount of Sales : " << "$" << TotalSales; Register << "\n"; } void SetNewBranch(char BranchId[]) { char fBranchId[5]; Register << "\n\n" << " Branch #: "; strncpy(fBranchId, BranchId, 4); fBranchId[4] = '\0'; Register << &fBranchId[0] << "\n\n"; Register << " ENTRY# ACCOUNT ID # AMOUNT PURCHASED"; Register << '\n'; } void PageBreak(char BranchId[], char ReportDate[], int PageNo) { char fBranchId[5], fReportDate[11]; Register << '\f' << setw(54) << "SEARTONS CREDIT CARD SYSTEM" << "\n" << setw(54) << "DAILY CHARGE SALES REGISTER" << "\n\n\n"; strncpy(fReportDate, ReportDate, 4); fReportDate[4] = '/'; strncpy(&fReportDate[5], &ReportDate[4], 2); fReportDate[7] = '/'; strncpy(&fReportDate[8], &ReportDate[6], 2); fReportDate[10] = '\0'; Register << " DATE: " << &fReportDate[0] << " " << " " << " " << "PAGE: " << PageNo << "\n\n"; Register << '\n'; } void EndBreak(double GrandTotal) { Register << '\n' << " Total Amount of Sales : $" << GrandTotal; } >> [?21h // FileName: LOADBRANCH.CXX // Purpose: Functions needed to Initialize, Open and Close Branch File Using RMS // Used in Programs: SALE.CXX, PAYMENT.CXX, RETURN.CXX void InitializeBranchFile() { cBranchFIL = cc$rms_fab; cBranchFIL.fab$b_dns = 3; cBranchFIL.fab$b_fac = FAB$M_GET; cBranchFIL.fab$b_shr = FAB$M_SHRGET; cBranchFIL.fab$l_fna = psFileName3; cBranchFIL.fab$b_fns = strlen(psFileName3); cBranchFIL.fab$l_fop = FAB$M_CIF; cBranchFIL.fab$w_mrs = CAnBranchRecSize; cBranchFIL.fab$b_org = FAB$C_IDX; cBranchFIL.fab$b_rat = FAB$M_CR; cBranchFIL.fab$b_rfm = FAB$C_FIX; cBranchFIL.fab$b_shr = FAB$M_NIL; cBranchFIL.fab$l_xab = (char *) &cBranchXABKEY0; cBranchREC = cc$rms_rab; cBranchREC.rab$l_fab = &cBranchFIL; cBranchXABKEY0 = cc$rms_xabkey; cBranchXABKEY0.xab$b_dtp = XAB$C_STG; cBranchXABKEY0.xab$b_flg = 0; cBranchXABKEY0.xab$w_pos0 = (char *) &(cBranch.BranchId[0]) - (char *) &(cBranch); cBranchXABKEY0.xab$b_ref = 0; cBranchXABKEY0.xab$b_siz0 = 4; } void OpenBranch() { RMSStatus = sys$create(&cBranchFIL); if (RMSStatus != RMS$_NORMAL && RMSStatus != RMS$_CREATED) ErrorExit("$OPEN", cBranchFIL.fab$l_fna); if (RMSStatus == RMS$_CREATED) printf("[Created New Data File]\n"); RMSStatus = sys$open(&cBranchFIL); RMSStatus = sys$connect(&cBranchREC); if (RMSStatus != RMS$_NORMAL) ErrorExit("$CONNECT", cBranchFIL.fab$l_fna); } void CloseBranch() { RMSStatus = sys$close(&cBranchFIL); if (RMSStatus != RMS$_NORMAL) ErrorExit("$CLOSE", cBranchFIL.fab$l_fna); } >> [?21h // FileName: LOADCLIENT.CXX // Purpose: Functions needed to Initialize, Open and Close Client File Using RMS // Used in Programs: SALE.CXX, ACCREC.CXX void InitializeClientFile(void) { cClientFIL = cc$rms_fab; cClientFIL.fab$b_dns = 3; cClientFIL.fab$b_fac = FAB$M_GET; // FAB$M_PUT | FAB$M_UPD; cClientFIL.fab$b_shr = FAB$M_SHRGET; // | FAB$M_SHRPUT | // FAB$M_SHRUPD | FAB$M_SHRDEL; cClientFIL.fab$l_fna = psFileName2; cClientFIL.fab$b_fns = strlen(psFileName2); cClientFIL.fab$l_fop = FAB$M_CIF; cClientFIL.fab$w_mrs = CAnClientRecSize; cClientFIL.fab$b_org = FAB$C_IDX; cClientFIL.fab$b_rat = FAB$M_CR; cClientFIL.fab$b_rfm = FAB$C_FIX; cClientFIL.fab$b_shr = FAB$M_NIL; cClientFIL.fab$l_xab = (char *) &cClientXABKEY0; cClientREC = cc$rms_rab; cClientREC.rab$l_fab = &cClientFIL; cClientXABKEY0 = cc$rms_xabkey; cClientXABKEY0.xab$b_dtp = XAB$C_STG; cClientXABKEY0.xab$b_flg = 0; cClientXABKEY0.xab$w_pos0 = (char *) &(cClient.AccountId[0]) - (char *) &(cClient); cClientXABKEY0.xab$b_ref = 0; cClientXABKEY0.xab$b_siz0 = 10; cClientXABKEY0.xab$l_nxt = (char *) &cClientXABKEY1; cClientXABKEY1 = cc$rms_xabkey; cClientXABKEY1.xab$b_dtp = XAB$C_STG; cClientXABKEY1.xab$b_flg = XAB$M_DUP | XAB$M_CHG; cClientXABKEY1.xab$w_pos0 = (char *) &(cClient.AccountStatus[0]) - (char *) &(cClient); cClientXABKEY1.xab$b_ref = 1; cClientXABKEY1.xab$b_siz0 = 2; cClientXABKEY1.xab$l_nxt = (char *) &cClientXABKEY2; cClientXABKEY2 = cc$rms_xabkey; cClientXABKEY2.xab$b_dtp = XAB$C_STG; cClientXABKEY2.xab$b_flg = XAB$M_DUP | XAB$M_CHG; cClientXABKEY2.xab$w_pos0 = (char *) &(cClient.IssueDate) - (char *) &(cClient); cClientXABKEY2.xab$b_ref = 2; cClientXABKEY2.xab$b_siz0 = 4; cClientXABKEY2.xab$l_nxt = (char *) &cClientXABKEY3; cClientXABKEY3 = cc$rms_xabkey; cClientXABKEY3.xab$b_dtp = XAB$C_STG; cClientXABKEY3.xab$b_flg = XAB$M_DUP | XAB$M_CHG; cClientXABKEY3.xab$w_pos0 = (char *) &(cClient.ExpiryDate) - (char *) &(cClient); cClientXABKEY3.xab$b_ref = 3; cClientXABKEY3.xab$b_siz0 = 4; cClientXABKEY3.xab$l_nxt = (char *) &cClientXABKEY4; cClientXABKEY4 = cc$rms_xabkey; cClientXABKEY4.xab$b_dtp = XAB$C_STG; cClientXABKEY4.xab$b_flg = XAB$M_DUP | XAB$M_CHG; cClientXABKEY4.xab$w_pos0 = (char *) &(cClient.cPrimary.FirstName[0]) - (char *) &(cClient); cClientXABKEY4.xab$b_ref = 4; cClientXABKEY4.xab$b_siz0 = 32; cClientXABKEY4.xab$l_nxt = (char *) &cClientXABKEY5; cClientXABKEY5 = cc$rms_xabkey; cClientXABKEY5.xab$b_dtp = XAB$C_STG; cClientXABKEY5.xab$b_flg = XAB$M_DUP | XAB$M_CHG; cClientXABKEY5.xab$w_pos0 = (char *) &(cClient.StatementDay) - (char *) &(cClient); cClientXABKEY5.xab$b_ref = 5; cClientXABKEY5.xab$b_siz0 = 4; cClientXABKEY5.xab$l_nxt = (char *) &cClientXABKEY6; cClientXABKEY6 = cc$rms_xabkey; cClientXABKEY6.xab$b_dtp = XAB$C_STG; cClientXABKEY6.xab$b_flg = XAB$M_DUP | XAB$M_CHG; cClientXABKEY6.xab$w_pos0 = (char *) &(cClient.LastPayDate) - (char *) &(cClient); cClientXABKEY6.xab$b_ref = 6; cClientXABKEY6.xab$b_siz0 = 4; cClientXABKEY6.xab$l_nxt = (char *) &cClientXABKEY7; cClientXABKEY7 = cc$rms_xabkey; cClientXABKEY7.xab$b_dtp = XAB$C_STG; cClientXABKEY7.xab$b_flg = XAB$M_DUP | XAB$M_CHG; cClientXABKEY7.xab$w_pos0 = (char *) &(cClient.LastPurchDate) - (char *) &(cClient); cClientXABKEY7.xab$b_ref = 7; cClientXABKEY7.xab$b_siz0 = 4; cClientXABKEY7.xab$l_nxt = (char *) &cClientXABKEY8; cClientXABKEY8 = cc$rms_xabkey; cClientXABKEY8.xab$b_dtp = XAB$C_STG; cClientXABKEY8.xab$b_flg = XAB$M_DUP | XAB$M_CHG; cClientXABKEY8.xab$w_pos0 = (char *) &(cClient.cAddress.Street[0]) - (char *) &(cClient); cClientXABKEY8.xab$b_ref = 8; cClientXABKEY8.xab$b_siz0 = 44; } void OpenClient() { RMSStatus = sys$create(&cClientFIL); if (RMSStatus != RMS$_NORMAL && RMSStatus != RMS$_CREATED) ErrorExit("$OPEN", cClientFIL.fab$l_fna); if (RMSStatus == RMS$_CREATED) printf("[Created New Data File]\n"); RMSStatus = sys$open(&cClientFIL); RMSStatus = sys$connect(&cClientREC); if (RMSStatus != RMS$_NORMAL) ErrorExit("$CONNECT", cClientFIL.fab$l_fna); } void CloseClient() { RMSStatus = sys$close(&cClientFIL); if (RMSStatus != RMS$_NORMAL) ErrorExit("$CLOSE", cClientFIL.fab$l_fna); } > VMS File Not Found. Download Cancelled.>> [?21h // FileName: LOADRETURN.CXX // Purpose: Functions needed to Initialize, Open and Close Sales File Using R MS // Used in Programs: RETURN.CXX, DAILY-RETURN.CXX void InitializeReturnFile() { cReturnFIL = cc$rms_fab; cReturnFIL.fab$b_dns = 3; cReturnFIL.fab$b_fac = FAB$M_DEL | FAB$M_GET | FAB$M_PUT | FAB$M_UPD; cReturnFIL.fab$b_shr = FAB$M_SHRGET | FAB$M_SHRPUT | FAB$M_SHRUPD | FAB$M_SHRDEL; cReturnFIL.fab$l_fna = psFileName; cReturnFIL.fab$b_fns = strlen(psFileName); cReturnFIL.fab$l_fop = FAB$M_CIF; cReturnFIL.fab$w_mrs = CAnReturnRecSize; cReturnFIL.fab$b_org = FAB$C_IDX; cReturnFIL.fab$b_rat = FAB$M_CR; cReturnFIL.fab$b_rfm = FAB$C_FIX; cReturnFIL.fab$b_shr = FAB$M_NIL; cReturnFIL.fab$l_xab = (char *) &cReturnXABKEY0; cReturnREC = cc$rms_rab; cReturnREC.rab$l_fab = &cReturnFIL; cReturnXABKEY0 = cc$rms_xabkey; cReturnXABKEY0.xab$b_dtp = XAB$C_STG; cReturnXABKEY0.xab$b_flg = 0; cReturnXABKEY0.xab$w_pos0 = (char *) &(cReturn.cReturnKey.AccountId[0]) - (char *) &(cR eturn); cReturnXABKEY0.xab$b_ref = 0; cReturnXABKEY0.xab$b_siz0 = 24; cReturnXABKEY0.xab$l_nxt = (char *) &cReturnXABKEY1; cReturnXABKEY1 = cc$rms_xabkey; cReturnXABKEY1.xab$b_dtp = XAB$C_STG; cReturnXABKEY1.xab$b_flg = XAB$M_DUP | XAB$M_CHG; cReturnXABKEY1.xab$w_pos0 = (char *) &(cReturn.BranchId[0]) - (char *) &(cReturn); cReturnXABKEY1.xab$b_ref = 1; cReturnXABKEY1.xab$b_siz0 = 4; cReturnXABKEY1.xab$l_nxt = (char *) &cReturnXABKEY2; cReturnXABKEY2 = cc$rms_xabkey; cReturnXABKEY2.xab$b_dtp = XAB$C_STG; cReturnXABKEY2.xab$b_flg = 0; cReturnXABKEY2.xab$w_pos0 = (char *) &(cReturn.ReturnNbr) - (char *) &(cReturn); cReturnXABKEY2.xab$b_ref = 2; cReturnXABKEY2.xab$b_siz0 = 4; } void OpenReturn() { RMSStatus = sys$create(&cReturnFIL); if (RMSStatus != RMS$_NORMAL && RMSStatus != RMS$_CREATED) ErrorExit("$OPEN", cReturnFIL.fab$l_fna); if (RMSStatus == RMS$_CREATED) printf("[Created New Data File]\n"); RMSStatus = sys$open(&cReturnFIL); RMSStatus = sys$connect(&cReturnREC); if (RMSStatus != RMS$_NORMAL) ErrorExit("$CONNECT", cReturnFIL.fab$l_fna); } void CloseReturn() { RMSStatus = sys$close(&cReturnFIL); if (RMSStatus != RMS$_NORMAL) ErrorExit("$CLOSE", cReturnFIL.fab$l_fna); } >> [?21h // FileName: LOADSALE.CXX // Purpose: Functions needed to Initialize, Open and Close Sales File Using R MS // Used in Programs: SALE.CXX, DAILY-SALE.CXX void InitializeSalesFile() { cSalesFIL = cc$rms_fab; cSalesFIL.fab$b_dns = 3; cSalesFIL.fab$b_fac = FAB$M_DEL | FAB$M_GET | FAB$M_PUT | FAB$M_UPD; cSalesFIL.fab$b_shr = FAB$M_SHRGET | FAB$M_SHRPUT | FAB$M_SHRUPD | FAB$M_SHRDEL; cSalesFIL.fab$l_fna = psFileName; cSalesFIL.fab$b_fns = strlen(psFileName); cSalesFIL.fab$l_fop = FAB$M_CIF; cSalesFIL.fab$w_mrs = CAnSalesRecSize; cSalesFIL.fab$b_org = FAB$C_IDX; cSalesFIL.fab$b_rat = FAB$M_CR; cSalesFIL.fab$b_rfm = FAB$C_FIX; cSalesFIL.fab$b_shr = FAB$M_NIL; cSalesFIL.fab$l_xab = (char *) &cSalesXABKEY0; cSalesREC = cc$rms_rab; cSalesREC.rab$l_fab = &cSalesFIL; cSalesXABKEY0 = cc$rms_xabkey; cSalesXABKEY0.xab$b_dtp = XAB$C_STG; cSalesXABKEY0.xab$b_flg = 0; cSalesXABKEY0.xab$w_pos0 = (char *) &(cSales.cSalesKey.AccountId[0]) - (char *) &(cSal es); cSalesXABKEY0.xab$b_ref = 0; cSalesXABKEY0.xab$b_siz0 = 24; cSalesXABKEY0.xab$l_nxt = (char *) &cSalesXABKEY1; cSalesXABKEY1 = cc$rms_xabkey; cSalesXABKEY1.xab$b_dtp = XAB$C_STG; cSalesXABKEY1.xab$b_flg = XAB$M_DUP | XAB$M_CHG; cSalesXABKEY1.xab$w_pos0 = (char *) &(cSales.BranchId[0]) - (char *) &(cSales); cSalesXABKEY1.xab$b_ref = 1; cSalesXABKEY1.xab$b_siz0 = 4; } void OpenSales() { RMSStatus = sys$create(&cSalesFIL); if (RMSStatus != RMS$_NORMAL && RMSStatus != RMS$_CREATED) ErrorExit("$OPEN", cSalesFIL.fab$l_fna); if (RMSStatus == RMS$_CREATED) printf("[Created New Data File]\n"); RMSStatus = sys$open(&cSalesFIL); RMSStatus = sys$connect(&cSalesREC); if (RMSStatus != RMS$_NORMAL) ErrorExit("$CONNECT", cSalesFIL.fab$l_fna); } void CloseSales() { RMSStatus = sys$close(&cSalesFIL); if (RMSStatus != RMS$_NORMAL) ErrorExit("$CLOSE", cSalesFIL.fab$l_fna); } >> [?21h // Filename: RMSFUNC.CXX // Purpose: RMS Functions to PAD fields, Display Strings and Display Error // Messages // Used in Programs: SALE.CXX, DAILY-SALE.CXX void PadSalesRecord() { char *psChar; Pad(&cSales.cSalesKey.AccountId[0],10); Pad(&cSales.cSalesKey.SaleDate[0],8); Pad(&cSales.cSalesKey.SaleTime[0],6); Pad(&cSales.BranchId[0],4); } void Pad(char *x, int size) { char *psChar; for (psChar = x+strlen(x); psChar < (x+size); *(psChar++) = ' '); } void DisplayString(char *psChar, int Size) { int i; for (i=0; i> [?21h // Filename: RMSFUNC2.CXX // Purpose: RMS Functions to PAD fields, Display Strings and Display Error // Messages // Used in Programs: PAYMENT.CXX, DAILY-PAYMENT.CXX void PadPaymentRecord() { char *psChar; Pad(&cPayment.cPaymentKey.AccountId[0],10); Pad(&cPayment.cPaymentKey.PaymentDate[0],8); Pad(&cPayment.cPaymentKey.PaymentTime[0],6); Pad(&cPayment.BranchId[0],4); Pad(&cPayment.PaymentType[0],2); Pad(&cPayment.ReferenceId[0],4); Pad(&cPayment.BranchProv[0],2); } void Pad(char *x, int size) { char *psChar; for (psChar = x+strlen(x); psChar < (x+size); *(psChar++) = ' '); } void DisplayString(char *psChar, int Size) { int i; for (i=0; i> [?21h // Filename: RMSFUNC3.CXX // Purpose: RMS Functions to PAD fields, Display Strings and Display Error // Messages // Used in Programs: RETURN.CXX, DAILY-RETURN.CXX void PadReturnRecord() { char *psChar; Pad(&cReturn.cReturnKey.AccountId[0],10); Pad(&cReturn.cReturnKey.ReturnDate[0],8); Pad(&cReturn.cReturnKey.ReturnTime[0],6); Pad(&cReturn.BranchId[0],4); } void Pad(char *x, int size) { char *psChar; for (psChar = x+strlen(x); psChar < (x+size); *(psChar++) = ' '); } void DisplayString(char *psChar, int Size) { int i; for (i=0; i> [?21h // Sales Program // By: Mike Gallant // Performs Sales, prints corresponding receipt and Writes to // or updates all necessary files #include rms #include stdio #include ssdef #include starlet #include string #include stdlib #include ctype #include processes #include climsgdef #include perror #include math #include time #include #include #include #include "conio.h" #include "invalnum.h" #include "inputreq2.h" #include "delay.h" extern void InitializeSalesFile(); extern void InitializeClientFile(); extern void InitializeBranchFile(); extern void OpenSales(); extern void CloseSales(); extern void OpenClient(); extern void CloseClient(); extern void OpenBranch(); extern void CloseBranch(); void PadSalesRecord(); void Pad(char *, int); void ErrorExit(char *, char *); void ShowARecord(); void ShowScreen(); extern "C" long int get_account_id(char *); long int EnterSaleAmount(void); void DisplayScreen(char *, char *); void WriteTransaction(long int, char *, char *); void ReadSeartons(void); void RewriteSeartons(void); void DisplayString(char *, int); extern "C" void update_client_file(char *, char *, char *); extern "C" void get_time_date(char *, char *); void CancelledClient(void); void InactiveClient(void); void PendingClient(void); void RejectedClient(void); void StolenClient(void); void SuspendedClient(void); int CheckCreditLimit(long int); long int ValidateStatus(long int); void GetBranch(void); void PrintReceipt(long int, char *, char *); void MakeAnother(void); // Prototypes for COBOL field conversion routines found in CONVPACK.OBJ extern void EnsureAllNumeric(char *); extern void AlignPIC9n(char *, long int, int, char); extern long int PIC9nToNumeric(char *, int, char); extern long int COMP3ToNumeric(char *, int); extern void NumericToCOMP3(char *, long int, int); #define CAnSalesRecSize 256 //(sizeof (struct CAnSales)) #define CAnBranchRecSize 256 //(sizeof (struct CAnBranch)) #define CAnClientRecSize 256 //(sizeof (struct CAnClient)) #define CAnClientKeySize 44 #define CAnSalesKeySize 24 #define CAnBranchKeySize 4 #define TotalBranches 15 /* RMS Initialization Stuff */ struct FAB cSalesFIL, cBranchFIL, cClientFIL; struct RAB cSalesREC, cBranchREC, cClientREC; struct XABKEY cSalesXABKEY0, cSalesXABKEY1, cBranchXABKEY0, cClientXABKEY0, cClientXABKEY1, cClientXABKEY2, cClientXABKEY3, cClientXABKEY4, cClientXABKEY5, cClientXABKEY6, cClientXABKEY7, cClientXABKEY8; /* All structures used in this program are listed below They include Client, Branch, Sales, and Seartons Work */ /* Primary Card Holders Name Sub-Structure */ struct CAcPrimary { char LastName[12], FirstName[18], MidInit[2]; }; /* Supplementary Card Holders Name Sub-structure */ struct CAcSecond { char LastName[12], FirstName[18], MidInit[2]; }; /* Primary Card Holder's Address Sub-Structure */ struct CAcAddress { char Street[18], City[18], Province[2], PostalCode[6]; }; struct CAnClient { char AccountId[10], AccountStatus[2]; int IssueDate, ExpiryDate, CardsIssued; struct CAcPrimary cPrimary; struct CAcSecond cSecond; int StatementDay; char PrevBalance[6], CurrentBalance[6], TotalPayments[6], TotalPurchases[6]; int LastPayDate, LastPurchDate; char MinPayDue[6], CreditLimit[6], ActualCrdLimit[6]; struct CAcAddress cAddress; char LangCode[2]; int LastContactDate; char WorkPhone[6], HomePhone[6], InterestOwed[6]; int DateOfBirth; char filler[42]; }; /* Sales Sub-Structure (Primary Unique Key of File) */ struct CAnSalesKey { char AccountId[10]; char SaleDate[8]; char SaleTime[6]; }; struct CAnSales { struct CAnSalesKey cSalesKey; char BranchId[4]; int SalesSlipNbr; int AuthNbr; char PurchaseAmt[6]; char filler[214]; }; struct CAnSeartons { int SalesSlipNbr, AuthNbr, ReturnNbr, IntRate, NAccountId; char filler[236]; }; struct CAnBranch { char BranchId[4], BranchName[18], BranchProv[2], filler[232]; }; /* Declare Structures Listed Above for use in this program */ struct CAnClient cClient; struct CAnSales cSales; struct CAnSeartons cSeartons; struct CAnBranch cBranch; /* Define files for use with RMS */ static char *psFileName = "[comp97.gallantm]sales-transaction.dat"; static char *psFileName2 = "[comp97.gallantm]client.dat"; static char *psFileName3 = "[comp97.gallantm]branch-info.dat"; /* I minimized on Globals, but these ones made my program work much better */ int RMSStatus; char AccountId[10]; char InputBuffer[512]; long int ChangeStatus; /* RMS functions to Init Files, Open Them and Close Them */ #include "loadsale.cxx" #include "loadclient.cxx" #include "loadbranch.cxx" /* Read & ReWrite Sales and Authorization Numbers to the Seartons Work File */ #include "updateseartons.cxx" /* Functions used by RMS to PAD files with spaces and Display Error messages */ #include "rmsfunc.cxx" /* Function to validate the Account Status */ #include "valstatus.cxx" /* Function to generate a Branch to originate the Sale from */ #include "getbranch.cxx" main() { long int TotalSale; /* Amount of Payment entered by operator */ long int Status = 99; /* Returned Account Status from COBOL program */ char TotalSalec[6]; /* Packed Decimal version of "TotalPayment" */ char TheTime[6]; /* Current Time returned from COBOL program */ char TheDate[8]; /* Current Date returned from COBOL program */ int EnufCredit; /* Field to indicate if Client has enough credit left to make purchase */ char PackStatus[6]; /* Account Status returned from COBOL program */ do { Status = 99; clrscr(); get_time_date(TheDate, TheTime); // External COBOL function to get Time and Date DisplayScreen(TheDate, TheTime); // Display initial headings on screen /* Open branch file and Get a branch to "Pretend" the sale is being made at */ InitializeBranchFile(); OpenBranch(); GetBranch(); CloseBranch(); /* Get an Account Id until they enter a valid one or until they have ha d enough */ while(Status == 99) { Status = get_account_id(AccountId); // External COBOL function to ge t Account Id from user gotoxy(1,20); clreol(); Status = ValidateStatus(Status); } /* If the Client is able to make Credit Purchases, do the following */ if(Status == 0 || Status == 2) { InputBuffer[0] = 'Y'; TotalSale = EnterSaleAmount(); /* If the User entered anything but nothing, do the following */ if(TotalSale != 0) { NumericToCOMP3(&TotalSalec[0], TotalSale, 6); InitializeClientFile(); OpenClient(); EnufCredit = CheckCreditLimit(TotalSale); CloseClient(); /* If the Client has enough credit to make the entered Sale, do the following */ if(EnufCredit) { ReadSeartons(); // Get Authorization Number & Sales Slip Nu mber RewriteSeartons(); // Write back incremented Auth. Nbr & Sl ip Nbr. PrintReceipt(TotalSale, TheDate, TheTime); InitializeSalesFile(); OpenSales(); gotoxy(31,18); cout << "Processing Sale...." << endl; Delay(2); // Pretend Sale actually takes more than millise conds gotoxy(27,20); cout << "Authorization Number : " << cSeartons.AuthNbr << en dl; WriteTransaction(TotalSale, TheDate, TheTime); // Write Sale s Transaction to File CloseSales(); NumericToCOMP3(&PackStatus[0], ChangeStatus, 6); // Pack Sta tus to send to COBOL program update_client_file(TotalSalec, AccountId, PackStatus); // Wr ite Purchase Amount to File Delay(2); } else MakeAnother(); } else MakeAnother(); } else MakeAnother(); } while(InputBuffer[0] == 'Y' || InputBuffer[0] == 'y'); gotoxy(1,22); clrbtm(); gotoxy(32,23); cout << "Press Enter:" << endl; cin.get(); cin.get(); return 0; } void MakeAnother(void) { gotoxy(1,22); clrbtm(); gotoxy(26,22); cout << "Enter Another Sale (Yes/No)" << endl; InputBuffer[0] = 0x0a; // Suppress any previous presses do { cInputRequired(54,22); cin >> InputBuffer; InputBuffer[0] = toupper(InputBuffer[0]); if(InputBuffer[0] == 'Y' || InputBuffer[0] == 'N') InputBuffer[1] = '&'; } while(InputBuffer[1] != '&'); } void PrintReceipt(long int SaleAmt, char TheDate[], char TheTime[]) { ofstream Receipt("[comp97.gallantm]RECEIPTS.DAT", ios::app); /* Used to properly format data going to receipt & to insert '\0' to make sure that only the characters I want printed are printed */ char BranchId[5], PropTime[9], AcctNbr[12], PropDate[11]; double fSaleAmt; /* Ugly, Ugly!! This is what makes C/C++ & characters a bad combo */ /* Simply put, Sets up System Date, Time, Account Id and Branch Id to be written to file without dumping memory */ strncpy(AcctNbr,cClient.AccountId,4); strncpy(&(AcctNbr[5]),&(cClient.AccountId[4]),6); AcctNbr[4] = '-'; AcctNbr[11] = '\0'; strncpy(PropDate, TheDate, 4); strncpy(&(PropDate[5]),&(TheDate[4]),2); strncpy(&(PropDate[8]),&(TheDate[6]),2); PropDate[4] = '/'; PropDate[7] = '/'; PropDate[10] = '\0'; strncpy(PropTime,TheTime,2); strncpy(&(PropTime[3]),&(TheTime[2]),2); strncpy(&(PropTime[6]),&(TheTime[4]),2); PropTime[2] = ':'; PropTime[5] = ':'; PropTime[8] = '\0'; strncpy(BranchId,cBranch.BranchId,4); BranchId[4] = '\0'; fSaleAmt = (double)(SaleAmt); fSaleAmt = ((fSaleAmt / 100) + 0.004); /* Code to print Receipt to file */ Receipt << " SEARTONS" << '\n'; Receipt << " SALES SLIP #" << cSeartons.SalesSlipNbr << '\n'; Receipt << " AUTHORIZATION #" << cSeartons.AuthNbr << '\n'; Receipt << " SALES TRANSACTION" << '\n'; Receipt << " DATE: " << PropDate << " " << PropTime << "\n\n"; Receipt << " SEARTONS BRANCH ID: " << BranchId << '\n'; Receipt << " ACC# " << AcctNbr << "\n\n"; Receipt << " AMT$ " << setiosflags(ios::fixed | ios::showpoint) << setw(12) << setprecision(2) << fSaleAmt << "\n\n"; Receipt << " SIG.__________________________" << "\n\n"; Receipt << " THANK YOU" << '\f'; Receipt.close(); } int CheckCreditLimit(long int AmtOfSale) { long int ActualCrdLimit; /* Amount of Credit left for Customer */ int EnufCredit; /* 1=OK | 0=You are overlimit */ double fActualCrdLimit; /* Float version of same name for screen display * / /* Load Client Record and check Sale Amount to insure that it is not over their Credit Available */ cClientREC.rab$b_krf = 0; cClientREC.rab$l_kbf = &AccountId[0]; cClientREC.rab$b_ksz = 10; cClientREC.rab$b_rac = RAB$C_KEY; cClientREC.rab$w_usz = CAnClientRecSize; cClientREC.rab$l_ubf = (char *) &cClient; RMSStatus = sys$get(&cClientREC); /* Same as a READ in COBOL */ /* Check RMS Flag to make sure that the right record was read */ if (RMSStatus != RMS$_NORMAL && RMSStatus != RMS$_RNF) ErrorExit("$GET", cClientFIL.fab$l_fna); else if (RMSStatus == RMS$_RNF) printf("Account Entered does not Exist.\n"); /* If all is well.... Check Credit Available to see that they have enou gh */ else { ActualCrdLimit = COMP3ToNumeric(&cClient.ActualCrdLimit[0], 6); if(ActualCrdLimit < AmtOfSale) { gotoxy(11,21); cout << "Insufficient Credit for Purchase -- Transaction Cancell ed" << endl; fActualCrdLimit = (double)(ActualCrdLimit); gotoxy(27,22); cout << "Credit Available: $" << setiosflags(ios::fixed) << setp recision(2) << (fActualCrdLimit / 100 + 0.004) << endl; EnufCredit = 0; Delay(3); } else EnufCredit = 1; } return EnufCredit; } void WriteTransaction(long int TotalSale, char TheDate[], char TheTime[]) { char TestString[24]; long int TempLONG; /* After hours of work, I came up with these three lines */ /* They create a concatenated key for the sales file consisting of AccountId, Date of Sale and Time of Sale to the second. */ /* What do you think the odds are of this key being duplicated */ strncpy(TestString, AccountId, 10); strncpy(&TestString[10], TheDate, 8); strncpy(&TestString[18], TheTime, 6); /* Make sure that the key made above is not a duplicate */ Pad(&TestString[0],24); cSalesREC.rab$b_krf = 0; cSalesREC.rab$l_kbf = &TestString[0]; cSalesREC.rab$b_ksz = 24; cSalesREC.rab$b_rac = RAB$C_KEY; cSalesREC.rab$w_usz = CAnSalesRecSize; cSalesREC.rab$l_ubf = (char *) &cSales; RMSStatus = sys$get(&cSalesREC); if(RMSStatus == RMS$_NORMAL) { printf("\n[Already on File.]\n"); return; } /* Start moving all the data to the structure so that I can write it to file */ strncpy(cSales.cSalesKey.AccountId,AccountId,10); strncpy(cSales.cSalesKey.SaleDate,TheDate,8); strncpy(cSales.cSalesKey.SaleTime,TheTime,6); strncpy(cSales.BranchId,cBranch.BranchId,4); cSales.SalesSlipNbr = cSeartons.SalesSlipNbr; cSales.AuthNbr = cSeartons.AuthNbr; NumericToCOMP3( &cSales.PurchaseAmt[0], TotalSale, 6); /* Get rid of NULLS in Character Fields */ PadSalesRecord(); /* Write it to file */ cSalesREC.rab$b_rac = RAB$C_KEY; cSalesREC.rab$w_rsz = CAnSalesRecSize; cSalesREC.rab$l_rbf = (char *) &cSales; RMSStatus = sys$put(&cSalesREC); /* Check RMS flag to see that the record was written */ if(RMSStatus != RMS$_NORMAL && RMSStatus != RMS$_DUP && RMSStatus != RMS$_OK_DUP) ErrorExit("$PUT", cSalesFIL.fab$l_fna); else if(RMSStatus == RMS$_NORMAL || RMSStatus == RMS$_OK_DUP) { gotoxy(22,22); cout << "Sale is Approved and Account Updated" << endl; } else { gotoxy(22,22); cout << "Index is a Duplicate -- Record Not Added" << endl; } } long int EnterSaleAmount(void) { long int AmountOfSale; double TempSale; /* Convert Sales Amount to Float for "Pretty" Screen Dis play */ char Prompt = 'N'; gotoxy(6,14); cout << "Total Price (in cents) '0 to Exit':" << endl; while(Prompt == 'N' || Prompt == 'n') { do { cInputRequired(43,14); cin >> AmountOfSale; } while(InvalidNumeric() || AmountOfSale < 0 || AmountOfSale > 9999999); /* To make the Sale Amount Aesthetically Pleasing */ TempSale = (double)(AmountOfSale); TempSale = ((TempSale / 100) + 0.004); gotoxy(43,14); cout << "$" << setiosflags(ios::fixed | ios::showpoint) << setprecision(2) << TempSale << endl; /* Did they enter the correct Sale Amount */ gotoxy(31,16); cout << "OK (Yes/No/Exit) : " << endl; gotoxy(50,16); cin.get(Prompt); switch(Prompt) { case 'Y': case 'y': gotoxy(1,22); clreol(); break; case 'n': case 'N': gotoxy(28,22); cout << "" << endl; Delay(1); break; case 'e': case 'E': AmountOfSale = 0; break; default: break; } } return AmountOfSale; } void DisplayScreen(char TheDate[], char TheTime[]) { /* Display The Date & Time on the screen -- C Style!!! */ gotoxy(68,1); DisplayString(&TheDate[0],4); gotoxy(72,1); cout << "-" << endl; gotoxy(73,1); DisplayString(&TheDate[4],2); gotoxy(75,1); cout << "-" << endl; gotoxy(76,1); DisplayString(&TheDate[6],2); gotoxy(70,2); DisplayString(&TheTime[0],2); gotoxy(72,2); cout << ":" << endl; gotoxy(73,2); DisplayString(&TheTime[2],2); gotoxy(75,2); cout << ":" << endl; gotoxy(76,2); DisplayString(&TheTime[4],2); /* Display Main Headings */ gotoxy(29,3); cout << "SEARTONS CHARGE CARD SYSTEM" << endl; gotoxy(29,5); cout << "RECORD A CHARGE SALE SCREEN" << endl; gotoxy(3,9); cout << "Account Id :" << endl; gotoxy(31,9); cout << "Name:" << endl; gotoxy(28,10); cout << "Address:" << endl; } >> [?21h // Filename: UPDATESEARTONS.CXX // Purpose: To Read in Sales Slip and Auth. Numbers and then Re-write them // back incremented by one. // Used in Programs: SALE.CXX void ReadSeartons(void) { ifstream Seartons("[comp97.gallantm]SEARTONS-WORK.DAT", ios::in); if(!Seartons) { cerr << "Seartons File Could not be Opened (IN)" << endl; exit(1); } Seartons.read((char *)&cSeartons, sizeof(struct CAnSeartons)); Seartons.close(); } void RewriteSeartons(void) { ofstream Seartons("[comp97.gallantm]SEARTONS-WORK.DAT", ios::out); if(!Seartons) { cerr << "Seartons File could not be Opened (OUT)" << endl; exit(1); } // To increment Sales Slip and Authorization numbers cSeartons.SalesSlipNbr++; cSeartons.AuthNbr++; Seartons.write((char *)&cSeartons, sizeof(struct CAnSeartons)); Seartons.close(); } >> [?21h // Filename: UPDATESEARTONSR.CXX // Purpose: To Read in Return Nbr and then Re-write it // back incremented by one. // Used in Programs: RETURN.CXX void ReadSeartons(void) { ifstream Seartons("[comp97.gallantm]SEARTONS-WORK.DAT", ios::in); if(!Seartons) { cerr << "Seartons File Could not be Opened (IN)" << endl; exit(1); } Seartons.read((char *)&cSeartons, sizeof(struct CAnSeartons)); Seartons.close(); } void RewriteSeartons(void) { ofstream Seartons("[comp97.gallantm]SEARTONS-WORK.DAT", ios::out); if(!Seartons) { cerr << "Seartons File could not be Opened (OUT)" << endl; exit(1); } // To increment Return Number cSeartons.ReturnNbr++; Seartons.write((char *)&cSeartons, sizeof(struct CAnSeartons)); Seartons.close(); } >> [?21h ; Main menu for Searton's Charge Card System ; By: Mike Gallant ; This is the main menu that accesses all functions available in the system SCREEN CHARGES MENU & ACTION LABEL "Select Desired Option: " & AT 22,24 NOMODE ; This code to get Time & Date was written by Rob Stobbs Comp '97 DEFINE TODAY-DATE NUMERIC*8 = SYSDATE DEFINE TODAY-TIME CHAR*4 = ASCII(SYSTIME,8)[1:4] FIELD TODAY-DATE NOID NOLABEL DATA AT 1,70 PREDISPLAY PICTURE "^^^^/^^/^^" FIELD TODAY-TIME NOID NOLABEL DATA AT 2,70 PREDISPLAY PICTURE "^^:^^" TITLE "SEARTONS CREDIT CARD SYSTEM" CENTERED AT 2,1 TITLE "MAIN MENU" CENTERED SKIP 1 TITLE "APPLICATIONS" AT 4,4 TITLE "SALES" AT 9,4 TITLE "PAYMENTS" AT 13,4 TITLE "RETURNS" AT 18,4 TITLE "STATEMENTS" AT 4,46 TITLE "CLIENT REQUEST" AT 8,46 TITLE "INQUIRIES" AT 13,46 TITLE "SUBMENUS" AT 18,56 TITLE "Press To Exit" CENTERED AT 23,1 ALIGN(5,8,33) CLUSTER AT 5,1 COMMAND "ru APPLENTRY" CLEAR ALL & LABEL "Enter a Credit Application" COMMAND "ru ACCEPTED" CLEAR ALL & LABEL "Accept a Credit Application" COMMAND "ru REJECTED" CLEAR ALL & LABEL "Reject a Credit Application" SKIP 2 COMMAND "RU SALE" CLEAR ALL & LABEL "Record a Sale" COMMAND "RU DAILY-SALE" CLEAR ALL & LABEL "Daily Sales Register" SKIP 2 COMMAND "RU PAYMENT" CLEAR ALL & LABEL "Record a Payment" COMMAND "RU DAILY-PAYMENT" CLEAR ALL & LABEL "Daily Payments Register" COMMAND "RU BRANCHPAY" NOID CLEAR ALL & LABEL "Branch Daily Payments Summary" SKIP 2 COMMAND "RU RETURN" CLEAR ALL & LABEL "Record a Return" COMMAND "RU DAILY-RETURN" CLEAR ALL & LABEL "Daily Returns Register" SKIP 1 ALIGN(47,50,78) CLUSTER AT 5,47 COMMAND "RU BILLING" CLEAR ALL & LABEL "Produce Billing Statements" COMMAND "RU INTEREST" CLEAR ALL & LABEL "Change Interest Rate" SKIP 2 COMMAND "RU CHANCRED" CLEAR ALL & LABEL "Name/Address Change" COMMAND "RU CANCELLED" CLEAR ALL & LABEL "Cancel Account" COMMAND "RU PRODUCE" NOID CLEAR ALL & LABEL "Produce New Card" SKIP 2 COMMAND "RU INQUIRE" CLEAR ALL & LABEL "On Client Account" COMMAND "RU OVERDUE" NOID CLEAR ALL & LABEL "On Overdue Accounts" COMMAND "RU PROVINCE" NOID CLEAR ALL & LABEL "On Nbr. Of Clients by Prov." SKIP 2 SUBSCREEN MAINTENANCE NOID LABEL "File Maintenance" SUBSCREEN SPECIAL LABEL "Special Reports" SUBSCREEN EXCEPTIONAL LABEL "Process Exceptional Clients" build >> [?21h ; Special Reports sub-menu for Searton's Charge Card System ; By: Mike Gallant ; This is the menu that accesses all functions related to reports SCREEN SPECIAL MENU & ACTION LABEL "Select Desired Option: " & AT 20,30 NOMODE DEFINE TODAY-DATE NUMERIC*8 = SYSDATE DEFINE TODAY-TIME CHAR*4 = ASCII(SYSTIME,8)[1:4] FIELD TODAY-DATE NOID NOLABEL DATA AT 1,70 PREDISPLAY PICTURE "^^^^/^^/^^" FIELD TODAY-TIME NOID NOLABEL DATA AT 2,70 PREDISPLAY PICTURE "^^:^^" TITLE "SEARTONS CREDIT CARD SYSTEM" CENTERED AT 2,1 TITLE "SPECIAL REPORTS MENU" CENTERED SKIP 1 TITLE "MISCELLANEOUS" AT 7,4 TITLE "SALES REPORTS" AT 13,4 TITLE "PAYMENTS REPORTS" AT 7,46 TITLE "RETURNS REPORTS" AT 13,46 TITLE "Press To Exit" CENTERED AT 21,1 ALIGN(5,8,33) CLUSTER AT 8,1 COMMAND "ru COLLECTION" NOID CLEAR ALL & LABEL "Collection Account Report" COMMAND "ru ACCEPTED" NOID CLEAR ALL & LABEL "Overdue Accounts Report" COMMAND "ru quarter" CLEAR ALL & LABEL "Quarterly Summary Report" COMMAND "RU ACCREC" CLEAR ALL & LABEL "Accounts Receivable Register" SKIP 2 COMMAND "RU WKLYSALE" NOID CLEAR ALL & LABEL "Weekly Sales Report" COMMAND "RU MTLYSALE" NOID CLEAR ALL & LABEL "Monthly Sales Report" COMMAND "RU YRLYSALE" NOID CLEAR ALL & LABEL "Yearly Sales Report" SKIP 1 ALIGN(47,50,78) CLUSTER AT 8,47 COMMAND "RU WKLYPAYMENT" NOID CLEAR ALL & LABEL "Weekly Payments Report" COMMAND "RU MTLYPAYMENT" NOID CLEAR ALL & LABEL "Monthly Payments Report" COMMAND "RU YRLYPAYMENT" NOID CLEAR ALL & LABEL "Yearly Payments Report" SKIP 3 COMMAND "RU WKLYSRETURN" NOID CLEAR ALL & LABEL "Weekly Returns Report" COMMAND "RU MTLYRETURN" NOID CLEAR ALL & LABEL "Monthly Returns Report" COMMAND "RU YRLYRETURN" NOID CLEAR ALL & LABEL "Yearly Returns Report" build >> [?21h ; Exceptional Accounts sub-menu for Searton's Charge Card System ; By: Mike Gallant ; This is the menu that accesses all functions related to accounts SCREEN EXCEPTIONAL MENU & ACTION LABEL "Select Desired Option: " & AT 11,24 NOMODE DEFINE TODAY-DATE NUMERIC*8 = SYSDATE DEFINE TODAY-TIME CHAR*4 = ASCII(SYSTIME,8)[1:4] FIELD TODAY-DATE NOID NOLABEL DATA AT 1,70 PREDISPLAY PICTURE "^^^^/^^/^^" FIELD TODAY-TIME NOID NOLABEL DATA AT 2,70 PREDISPLAY PICTURE "^^:^^" TITLE "SEARTONS CREDIT CARD SYSTEM" CENTERED AT 2,1 TITLE "EXCEPTIONAL ACCOUNTS MENU" CENTERED SKIP 1 TITLE "Press To Exit" CENTERED AT 12,1 ALIGN(31,34,64) CLUSTER AT 7,1 COMMAND "ru RENEWAL" NOID CLEAR ALL & LABEL "Create Renewal Accounts List and Letter" COMMAND "ru INACTIVE" CLEAR ALL & LABEL "Create Inactive Client List" build >> [?21h SCREEN ACCOUNT-INQUIRY ACTION LABEL "Enter 'F' to Search: " AT 2,20 & ACTIVITIES FIND NOMODE FIELDMARK FILE CLIENT DEFINE NAME CHAR*32 = & PACK(PRIMARY-LAST-NAME OF CLIENT + PRIMARY-MID-INIT OF CLIENT + & PRIMARY-FIRST-NAME OF CLIENT) TEMPORARY GET-BILLING CHAR*1 INITIAL "N" DEFINE GET-ACCOUNT-ID CHAR*10 = ACCOUNT-ID OF CLIENT DEFINE ACCT-STATUS CHAR*10 = & CASE OF ACCOUNT-STATUS OF CLIENT & WHEN "A" THEN "ACTIVE" & WHEN "U" THEN "SUSPENDED" & WHEN "I" THEN "INACTIVE" & WHEN "S" THEN "STOLEN" & WHEN "P" THEN "PENDING" & WHEN "R" THEN "REJECTED" & WHEN "C" THEN "CANCELLED" DEFINE LANGUAGE-CODE CHAR*7 = & CASE OF LANG-CODE OF CLIENT & WHEN "E" THEN "ENGLISH" & WHEN "F" THEN "FRENCH" & WHEN "S" THEN "SPANISH" TITLE "GENERAL ACCOUNT INQUIRIES" AT 1,28 TITLE "Account Id:" AT 4,5 TITLE "Name:" AT 5,5 TITLE "Address:" AT 6,5 TITLE "Phone:" AT 9,5 TITLE "Birth Date:" AT 10,5 TITLE "Current Balance:" AT 4,44 TITLE "Payment Due:" AT 5,44 TITLE "Credit Limit:" AT 6,44 TITLE "Credit Available:" AT 8,44 TITLE "Language Code:" AT 9,44 TITLE "Status:" AT 10,44 FIELD ACCOUNT-ID OF CLIENT NOID NOLABEL DATA AT 4,17 FIELD PRIMARY-CARD-HOLDER OF CLIENT NOLABEL NOID DATA AT 5,11 ;FIELD NAME NOID NOLABEL DATA AT 5,11 FIELD STREET OF CLIENT NOID NOLABEL DATA AT 6,14 FIELD CITY OF CLIENT NOENTRY NOID NOLABEL DATA AT 7,14 FIELD PROVINCE OF CLIENT NOENTRY NOID NOLABEL DATA AT 8,14 FIELD POSTAL-CODE OF CLIENT NOENTRY NOID NOLABEL DATA AT 8,19 FIELD CURRENT-BALANCE OF CLIENT NOENTRY NOID NOLABEL DATA AT 4,62 FIELD MIN-PAY-DUE OF CLIENT NOENTRY NOID NOLABEL DATA AT 5,62 FIELD CREDIT-LIMIT OF CLIENT NOENTRY NOID NOLABEL DATA AT 6,62 FIELD ACTUAL-CRD-LIMIT OF CLIENT NOENTRY NOID NOLABEL DATA AT 8,62 FIELD HOME-PHONE OF CLIENT NOENTRY NOID NOLABEL DATA AT 9,13 FIELD DATE-OF-BIRTH OF CLIENT NOENTRY NOID NOLABEL DATA AT 10,17 FIELD LANGUAGE-CODE NOENTRY NOID NOLABEL DATA AT 9,61 FIELD ACCT-STATUS NOENTRY NOID NOLABEL DATA AT 10,61 FIELD GET-BILLING LABEL & "Do you want to see billing statement (Y/N)?" AT 12,13 DATA AT 12,57 & UPSHIFT ;SUBSCREEN ACCOUNT-TRANS PASSING CLIENT AUTO MODE SAME IF GET-BILLING = "Y" BUILD ;SCREEN ACCOUNT-TRANS RECEIVING CLIENT & ; FROM 15,1 TO 23,80 ;FILE CLIENT MASTER ;FILE SALES-TRANSACTION ; SELECT IF ACCOUNT-ID = GET-ACCOUNT-ID ;TITLE "BILLING STATEMENT" AT 3,12 ;FILE SALES-TRANSACTION SECONDARY ;FILE RETURNS SECONDARY ;FILE PAYMENT-TRANSACTION SECONDARY ;BUILD >> [?21h ; INACTIVE.QZS ; This report produces the Inactive Client List ; Files used for Report ACCESS CLIENT ; To Determine if Client has not made a purchase for more than 90 days DEFINE CURRDATE DATE = SYSDATE DEFINE LAST-P-DATE DATE = LAST-PURCH-DATE DEFINE NOBUYDAYS NUMERIC*5 = & DAYS(CURRDATE) - DAYS(LAST-P-DATE) SELECT IF NOBUYDAYS GT 90 AND (ACCOUNT-STATUS = "A" OR ACCOUNT-STATUS = "I") PAGE HEADING TAB 26 "SEARTONS CHARGE CARD SYSTEM" & TAB 69 "Page:" SYSPAGE & SKIP 1 TAB 30 "INACTIVE CLIENT LIST" & SKIP 1 TAB 32 "As Of:" SYSDATE & SKIP 2 KEEP COLUMN HEADINGS ; Fields to Print to Report REPORT ACCOUNT-ID PRIMARY-CARD-HOLDER & LAST-PURCH-DATE FORMAT YYYYMMDD SEPARATOR "-" & LAST-CONTACT-DATE FORMAT YYYYMMDD SEPARATOR "-" FINAL FOOTING SKIP 3 & TAB 10 "Nbr of Inactive Accounts:" COUNT ; Send Report to Disc File -- Name is INACTIVE.TXT SET REPORT DEVICE DISC NAME INACTIVE NOVERIFY GO >> [?21h ; QUARTER.QZS ; This report produces the MIS summary report ; Files used with report ACCESS BRANCH-INFO LINK TO SALES-TRANSACTION AND TO PAYMENT-TRANSACTION AND TO R ETURNS PAGE HEADING TAB 26 "SEARTONS CHARGE CARD SYSTEM" & SKIP 1 TAB 28 "QUARTERLY SUMMARY REPORT" & SKIP 1 TAB 32 "As Of:" SYSDATE & SKIP 2 KEEP COLUMN HEADINGS SORT ON BRANCH-ID REPORT ; Print total Sales, Payments and Returns totals for each branch FOOTING AT BRANCH-ID & BRANCH-ID & PURCHASE-AMT SUBTOTAL PICTURE "^^^,^^^.^^" FLOAT "$" & PAYMENT-AMT SUBTOTAL PICTURE "^^^,^^^.^^" FLOAT "$" & RETURN-AMT SUBTOTAL PICTURE "^^^,^^^.^^" FLOAT "$" ; Print Grand Total of all Sales, Payments and Returns FINAL FOOTING SKIP 2 "TOTALS:" & TAB 10 PURCHASE-AMT SUBTOTAL PICTURE "^^,^^^,^^^.^^" FLOAT "$" & TAB 24 PAYMENT-AMT SUBTOTAL PICTURE "^^,^^^,^^^.^^" FLOAT "$" & TAB 37 RETURN-AMT SUBTOTAL PICTURE "^^,^^^,^^^.^^" FLOAT "$" ; Send Report to Disc file -- Name is QUARTER.TXT SET REPORT DEVICE DISC NAME QUARTER GO >> [?21h struct CAcPrimary { char FirstName[18], LastName[12], MidInit[2]; }; struct CAcSecond { char FirstName[18], LastName[12], MidInit[2]; }; struct CAcAddress { char Street[18], City[18], Province[2], PostalCode[6]; }; struct CAnClient { char AccountId[10], AccountStatus[2]; int IssueDate, ExpiryDate, CardsIssued; struct CAcPrimary cPrimary; struct CAcSecond cSecond; int StatementDay; char PrevBalance[6], CurrentBalance[6], TotalPayments[6], TotalPurchases[6]; int LastPayDate, LastPurchDate; char MinPayDue[6], CreditLimit[6], ActualCrdLimit[6]; struct CAcAddress cAddress; char LangCode[2]; int LastContactDate; char WorkPhone[6], HomePhone[6], InterestOwed[6]; int DateOfBirth; char filler[42]; }; >> [?21h // Renamed CONIO.H by Mike Gallant with minor changes to a few commands /* SCREEN.H */ /* */ /* Mess with your Cursor & Screen using ANSI.SYS commands. */ /* */ /* Consult a DOS manual if you want more details. */ /* */ /* J.E. Marriott / NBCC-SJ / Mar.92 */ #define gotoxy(k,r) printf("%c%c%c%c%c%c%c%c",0x1B,0x5B,\ digit_[r/10],digit_[r%10],0x3B,\ digit_[k/10],digit_[k%10],0x48) #define set_color(a,f,b) printf("%c%c%c%c%c%c%c%c%c%c",0x1B,0x5B,\ digit_[a],0x3B,digit_[f%10],digit_[f/10],\ 0x3B,digit_[b%10],digit_[b/10],0x6D) #define clrscr() printf("%c%c%c%c%c%c%c",\ 0x1B,0x5B,0x32,0x4A,0x1B,0x5B,0x48) #define normal_output() printf("%c%c%c%c", 0x1B,0x5B,0x30,0x6D) #define bold_output() printf("%c%c%c%c", 0x1B,0x5B,0x31,0x6D) #define underscored_output() printf("%c%c%c%c", 0x1B,0x5B,0x34,0x6D) #define blinking_output() printf("%c%c%c%c", 0x1B,0x5B,0x35,0x6D) #define highlighted_output() printf("%c%c%c%c", 0x1B,0x5B,0x37,0x6D) #define conceal_output() printf("%c%c%c%c", 0x1B,0x5B,0x38,0x6D) #define clrbtm() printf("%c%c%c", 0x1B,0x5B,0x4A) #define clreol() printf("%c%c%c", 0x1B,0x5B,0x4B) #define delete_line()printf("%c%c%c", 0x1B,0x5B,0x4D) #define insert_line() printf("%c%c%c", 0x1B,0x5b,0x4C) #define set_mode(a) printf("%c%c%c%c", 0x1B,0x5B,digit_[a],0x68) static char digit_[10] = { 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39 }; >> [?21h /* Header File for COBOL Field Conversion Routines */ /* J.E. Marriott / NBCC-SJ / Mar.92 */ /* To be used with COBOL.C */ static char comp3_byte_mask[100] = { 0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09, 0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x18, 0x19, 0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27, 0x28, 0x29, 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x40, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, 0x50, 0x51, 0x52, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59, 0x60, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x80, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88, 0x89, 0x90, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97, 0x98, 0x99 }; /* ...(1 of 4) arrays required by COMP-3 Conversion routines. */ static char packed_sign[6] = { 0xA0, 0xB0, 0xC0, 0xD0, 0xE0, 0xF0 }; /* ...(2 of 4) arrays required by COMP-3 Conversion routines. */ static char pos_comp3_sign_byte[10] = { 0x0C, 0x1C, 0x2C, 0x3C, 0x4C, 0x5C, 0x6C, 0x7C, 0x8C, 0x9C }; /* ...(3 of 4) arrays required by COMP-3 Conversion routines. */ static char neg_comp3_sign_byte[10] = { 0x0D, 0x1D, 0x2D, 0x3D, 0x4D, 0x5D, 0x6D, 0x7D, 0x8D, 0x9D }; /* ...(4 of 4) arrays required by COMP-3 Conversion routines. */ static char ascii_digit[10] = { 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39 }; /* ...(1 of 2) arrays required by PIC 9(n) & S9(n) routines. */ static char overpunch[20] = { 0x7B, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, 0x7D, 0x4A, 0x4B, 0x4C, 0x4D, 0x4E, 0x4F, 0x50, 0x51, 0x52 }; /* ...(2 of 2) arrays required by PIC 9(n) & S9(n) routines. */ /* Function Prototypes. */ void ensure_all_numeric(char *string_io); void align_pic9n(char *string_io, long int number_in, int nbr_of_bytes, char field_type); long int pic9n_to_numeric(char *string_in, int nbr_of_bytes, char field_type); long int comp3_to_numeric (char *string_in, int nbr_of_bytes); void numeric_to_comp3(char *string_out, long int number_in, int nbr_of_bytes); >> [?21h /* DELAY.H */ /* Designed by: Mike Gallant COMP '97 Feb. '97 Purpose: To cause a delay in process by waiting a given # of seconds specified by the incoming INT. */ #include time void Delay(int TheDelay) { unsigned long int TheTime, TheTime2; time(&TheTime); TheTime += TheDelay; TheTime2 = 0; while(TheTime > TheTime2) time(&TheTime2); } >> [?21h /* INPUTREQ.H */ // Written By: J.E. Marriott / NBCC-SJ /* Purpose: Prevent no entry in a field */ void InputRequired(int x, int y) { char Eat; gotoxy(x,y); cin.clear(); while((Eat=cin.get()) == 0x0A){ cout << '\a'<< endl; gotoxy(x,y);} cin.putback(Eat); } >> [?21h /* INPUTREQ2.H */ // Written By: J.E. Marriott / NBCC-SJ // Modified By: Mike Gallant // Purpose: Prevent no entry in a field // Changes: Modifed program to Clear to bottom of screen instead of just // clearing the field that is being input. void cInputRequired(int x, int y) { char Eat; gotoxy(x,y); clrbtm(); cin.clear(); while((Eat=cin.get()) == 0x0A){ cout << '\a'<< endl; gotoxy(x,y);} cin.putback(Eat); } >> [?21h /* INVALNUM.H */ // Written By: J.E. Marriott / NBCC-SJ /* Purpose: To check entry to make sure that integer fields contain only integers */ int InvalidNumeric() { if (cin.good()) if (cin.get()==0x0A) return 0; // There's a rea son for 2 ifs!!! cin.clear(); while(cin.get()!=0x0A); // Eat t he bad characters. cout << '\a' << endl; return 1; } >> [?21h /* SCREEN.H */ /* */ /* Mess with your Cursor & Screen using ANSI.SYS commands. */ /* */ /* Consult a DOS manual if you want more details. */ /* */ /* J.E. Marriott / NBCC-SJ / Mar.92 */ #define position_cursor(r,k) printf("%c%c%c%c%c%c%c%c",0x1B,0x5B,\ digit_[r/10],digit_[r%10],0x3B,\ digit_[k/10],digit_[k%10],0x48) #define set_color(a,f,b) printf("%c%c%c%c%c%c%c%c%c%c",0x1B,0x5B,\ digit_[a],0x3B,digit_[f%10],digit_[f/10],\ 0x3B,digit_[b%10],digit_[b/10],0x6D) #define clear_screen() printf("%c%c%c%c%c%c%c",\ 0x1B,0x5B,0x32,0x4A,0x1B,0x5B,0x48) #define normal_output() printf("%c%c%c%c", 0x1B,0x5B,0x30,0x6D) #define bold_output() printf("%c%c%c%c", 0x1B,0x5B,0x31,0x6D) #define underscored_output() printf("%c%c%c%c", 0x1B,0x5B,0x34,0x6D) #define blinking_output() printf("%c%c%c%c", 0x1B,0x5B,0x35,0x6D) #define highlighted_output() printf("%c%c%c%c", 0x1B,0x5B,0x37,0x6D) #define conceal_output() printf("%c%c%c%c", 0x1B,0x5B,0x38,0x6D) #define clear_to_bottom() printf("%c%c%c", 0x1B,0x5B,0x4A) #define clear_to_eol() printf("%c%c%c", 0x1B,0x5B,0x4B) #define delete_line()printf("%c%c%c", 0x1B,0x5B,0x4D) #define insert_line() printf("%c%c%c", 0x1B,0x5b,0x4C) #define set_mode(a) printf("%c%c%c%c", 0x1B,0x5B,digit_[a],0x68) static char digit_[10] = { 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39 }; >> [?21h * This copy library is used to store a record that is read from the * Branch-Info File. 01 BRANCH-READ-IN. 05 BBRANCH-ID PIC X(04). 05 BBRANCH-NAME PIC X(18). 05 BBRANCH-PROV PIC X(02). 05 FILLER PIC X(232). >> [?21h CHANGE-INFO. MOVE "N" TO GO-FLAG. MOVE "Y" TO JUNK-FLAG. PERFORM CLEAR-20. DISPLAY "Enter name of field to change, 99 to end:" LINE 22 COLUMN 10. ACCEPT FIELD-TO-CHANGE LINE 22 COLUMN 57 PROTECTED WITH CONVERSION. DISPLAY SPACES LINE 22 ERASE TO END OF LINE. PERFORM CLEAR-20. EVALUATE FIELD-TO-CHANGE WHEN 99 MOVE "N" TO CHANGE-FLAG MOVE "Y" TO GO-FLAG WHEN 1 PERFORM GET-PRIMARY-LAST-NAME UNTIL NOT-JUNK WHEN 2 PERFORM GET-PRIMARY-FIRST-NAME UNTIL NOT-JUNK WHEN 3 PERFORM GET-PRIMARY-MID-INIT UNTIL NOT-JUNK WHEN 4 PERFORM GET-STREET UNTIL OKAY WHEN 5 PERFORM GET-CITY UNTIL OKAY WHEN 6 PERFORM GET-PROVINCE UNTIL OKAY WHEN 10 PERFORM GET-DATE-OF-BIRTH WHEN 12 PERFORM GET-SUPP-CARD WHEN 13 PERFORM GET-SUPP-CARD WHEN 14 PERFORM GET-SUPP-CARD WHEN 8 PERFORM GET-HOME-PHONE WHEN 9 DISPLAY "Hit to default to Home Phone Number" LINE 22 COL UMN 17 PERFORM GET-WORK-PHONE DISPLAY SPACES LINE 22 ERASE TO END OF LINE WHEN 11 PERFORM GET-LANGUAGE-CODE UNTIL OKAY PERFORM DECODE-LANG-CODE DISPLAY O-LANG-CODE LINE 12 COLUMN 66 WHEN 7 PERFORM GET-POSTAL-CODE WHEN 15 PERFORM GET-CREDIT-LIMIT UNTIL OKAY WHEN OTHER PERFORM CLEAR-20 DISPLAY "INVALID ENTRY" LINE 20 COLUMN 10 MOVE 2 TO DELAY CALL "LIB$WAIT" USING BY REFERENCE DELAY END-EVALUATE. GET-SUPP-CARD. PERFORM GET-SECOND-LAST-NAME UNTIL NOT-JUNK. MOVE "Y" TO JUNK-FLAG. PERFORM GET-SECOND-FIRST-NAME UNTIL NOT-JUNK. MOVE "Y" TO JUNK-FLAG. PERFORM GET-SECOND-MID-INIT UNTIL NOT-JUNK. DECODE-LANG-CODE. EVALUATE LANG-CODE WHEN "E" MOVE "ENGLISH" TO O-LANG-CODE WHEN "F" MOVE "FRENCH" TO O-LANG-CODE WHEN "S" MOVE "SPANISH" TO O-LANG-CODE END-EVALUATE. >> [?21h CLEAR-20. DISPLAY SPACE LINE 20 ERASE TO END OF LINE. >> [?21h * This copy library is used to store a record that is read from the Client File 01 CLIENT-READ-IN. 05 ACCOUNT-ID PIC X(10). 88 VALID-ACCOUNT VALUES "AAAA0000" THRU "ZZZZ9999". 05 ACCOUNT-STATUS PIC X(02). 05 ISSUE-DATE PIC S9(09) COMP. 05 EXPIRY-DATE PIC S9(09) COMP. 05 CARDS-ISSUED PIC S9(09) COMP. 05 PRIMARY-CARD-HOLDER. 10 PRIMARY-LAST-NAME PIC X(12). 10 PRIMARY-FIRST-NAME PIC X(18). 10 PRIMARY-MID-INIT PIC X(02). 05 SECOND-CARD-HOLDER. 10 SECOND-LAST-NAME PIC X(12). 10 SECOND-FIRST-NAME PIC X(18). 10 SECOND-MID-INIT PIC X(02). 05 STATEMENT-DAY PIC S9(09) COMP. 05 PREV-BALANCE PIC S9(11) COMP-3. 05 CURRENT-BALANCE PIC S9(11) COMP-3. 05 TOTAL-PAYMENTS PIC S9(11) COMP-3. 05 TOTAL-PURCHASES PIC S9(11) COMP-3. 05 LAST-PAY-DATE PIC S9(09) COMP. 05 LAST-PURCH-DATE PIC S9(09) COMP. 05 MIN-PAY-DUE PIC S9(11) COMP-3. 05 CREDIT-LIMIT PIC S9(11) COMP-3. 88 VALID-CREDIT-LIMIT VALUES 50 THRU 500000. 05 ACTUAL-CRD-LIMIT PIC S9(11) COMP-3. 05 CARD-HOLDER-ADDRESS. 10 STREET PIC X(18). 10 CITY PIC X(18). 10 PROVINCE PIC X(02). 88 VALID-PROV VALUES "NB" "PE" "NS" "NF" "QE" "ON" "MB" "SK" "AB" "BC" "YT" "NT". 10 POSTAL-CODE PIC X(06). 05 LANG-CODE PIC X(02). 88 VALID-LANGUAGE VALUES "E" "F" "S". 05 LAST-CONTACT-DATE PIC S9(09) COMP. 05 WORK-PHONE PIC S9(11) COMP-3. 05 HOME-PHONE PIC S9(11) COMP-3. 05 INTEREST-OWED PIC S9(11) COMP-3. 05 DATE-OF-BIRTH PIC S9(09) COMP. 88 VALID-BIRTHS VALUES 19000000 THRU 20991231. 05 FILLER PIC X(42). >> [?21h * This copy library is used to store a record that is read from the Client File 01 CLIENT-READ-IN. 05 ACCOUNT-ID PIC X(10). 88 VALID-ACCOUNT VALUES "AAAA0000" THRU "ZZZZ9999". 05 ACCOUNT-STATUS PIC X(02). 05 ISSUE-DATE PIC S9(09) COMP. 05 EXPIRY-DATE PIC S9(09) COMP. 05 CARDS-ISSUED PIC S9(09) COMP. 05 PRIMARY-CARD-HOLDER. 10 PRIMARY-LAST-NAME PIC X(12). 10 PRIMARY-FIRST-NAME PIC X(18). 10 PRIMARY-MID-INIT PIC X(02). 05 SECOND-CARD-HOLDER. 10 SECOND-LAST-NAME PIC X(12). 10 SECOND-FIRST-NAME PIC X(18). 10 SECOND-MID-INIT PIC X(02). 05 STATEMENT-DAY PIC S9(09) COMP. 05 PREV-BALANCE PIC S9(11) COMP-3. 05 CURRENT-BALANCE PIC S9(11) COMP-3. 05 TOTAL-PAYMENTS PIC S9(11) COMP-3. 05 TOTAL-PURCHASES PIC S9(11) COMP-3. 05 LAST-PAY-DATE PIC S9(09) COMP. 05 LAST-PURCH-DATE PIC S9(09) COMP. 05 MIN-PAY-DUE PIC S9(11) COMP-3. 05 CREDIT-LIMIT PIC S9(11) COMP-3. 88 VALID-CREDIT-LIMIT VALUES 50 THRU 500000. 05 ACTUAL-CRD-LIMIT PIC S9(11) COMP-3. 05 CARD-HOLDER-ADDRESS. 10 STREET PIC X(18). 10 CITY PIC X(18). 10 PROVINCE PIC X(02). 88 VALID-PROV VALUES "NB" "PE" "NS" "NF" "QE" "ON" "MB" "SK" "AB" "BC" "YT" "NT". 10 POSTAL-CODE PIC X(06). 05 LANG-CODE PIC X(02). 88 VALID-LANGUAGE VALUES "E" "F" "S". 05 LAST-CONTACT-DATE PIC S9(09) COMP. 05 WORK-PHONE PIC S9(11) COMP-3. 05 HOME-PHONE PIC S9(11) COMP-3. 05 INTEREST-OWED PIC S9(11) COMP-3. 05 DATE-OF-BIRTH PIC S9(09) COMP. 88 VALID-BIRTHS VALUES 19000000 THRU 20991231. 05 FILLER PIC X(42). >> [?21h GET-CREDIT-LIMIT. PERFORM CLEAR-20. DISPLAY "Enter New Credit Limit" LINE 20 COLUMN 10. ACCEPT O-CREDIT-LIMIT LINE 13 COLUMN 66 PROTECTED WITH AUTOTERMINATE WITH CONVERSION DEFAULT IS CURRENT VALUE. IF NOT A-VALID-CREDIT-LIMIT THEN MOVE "N" TO GO-FLAG DISPLAY "Invalid or Illegal Credit Limit Entered" LINE 22 COLUMN 20 ELSE MOVE "Y" TO GO-FLAG DISPLAY SPACES LINE 22 ERASE TO END OF LINE MOVE O-CREDIT-LIMIT TO CREDIT-LIMIT COMPUTE O-ACTUAL-CRD-LIMIT = (O-CREDIT-LIMIT - CREDIT-LIMIT) ADD O-ACTUAL-CRD-LIMIT TO ACTUAL-CRD-LIMIT END-IF. >> [?21h EVALUATE LANG-CODE WHEN "E" MOVE "ENGLISH" TO O-LANGUAGE-CODE WHEN "F" MOVE "FRENCH" TO O-LANGUAGE-CODE WHEN "S" MOVE "SPANISH" TO O-LANGUAGE-CODE END-EVALUATE. >> [?21h EVALUATE ACCOUNT-STATUS WHEN "A" MOVE "ACTIVE" TO O-STATUS WHEN "U" MOVE "SUSPENDED" TO O-STATUS WHEN "I" MOVE "INACTIVE" TO O-STATUS WHEN "S" MOVE "STOLEN" TO O-STATUS WHEN "P" MOVE "PENDING" TO O-STATUS WHEN "R" MOVE "REJECTED" TO O-STATUS WHEN "C" MOVE "CANCELLED" TO O-STATUS END-EVALUATE. >> [?21h * File Definition for BRANCH-INFO File FD BRANCH-FILE BLOCK CONTAINS 8 RECORDS RECORD CONTAINS 256 CHARACTERS LABEL RECORDS STANDARD. * Define Indexes given in SELECT statement 01 BRANCH-KEYS. 05 IDX-BRANCH PIC X(04). 05 FILLER PIC X(252). >> [?21h * File Definition for CLIENT file. FD CLIENT-FILE BLOCK CONTAINS 8 RECORDS RECORD CONTAINS 256 CHARACTERS LABEL RECORDS STANDARD. * Define Indexes given in SELECT statement 01 CLIENT-KEYS. 05 IDX-ACCOUNT-ID PIC X(10). 05 IDX-ACCOUNT-STATUS PIC X(02). 05 IDX-ISSUE-DATE PIC S9(09) COMP. 05 IDX-EXPIRY-DATE PIC S9(09) COMP. 05 FILLER PIC S9(09) COMP. 05 IDX-PRIMARY-CARD-HOLDER PIC X(32). 05 FILLER PIC X(32). 05 IDX-STATEMENT-DAY PIC S9(09) COMP. 05 FILLER PIC S9(11) COMP-3. 05 FILLER PIC S9(11) COMP-3. 05 FILLER PIC S9(11) COMP-3. 05 FILLER PIC S9(11) COMP-3. 05 IDX-LAST-PAY-DATE PIC S9(09) COMP. 05 IDX-LAST-PURCH-DATE PIC S9(09) COMP. 05 FILLER PIC S9(11) COMP-3. 05 FILLER PIC S9(11) COMP-3. 05 FILLER PIC S9(11) COMP-3. 05 IDX-CARD-HOLDER-ADDRESS PIC X(44). 05 FILLER PIC X(02). 05 FILLER PIC S9(09) COMP. 05 FILLER PIC S9(11) COMP-3. 05 FILLER PIC S9(11) COMP-3. 05 FILLER PIC S9(11) COMP-3. 05 FILLER PIC S9(09) COMP. 05 FILLER PIC X(42). >> [?21h * File Definition for PAYMENT-TRANSACTION File FD PAYMENT-FILE BLOCK CONTAINS 8 RECORDS RECORD CONTAINS 256 CHARACTERS LABEL RECORDS STANDARD. * Define Indexes given in SELECT Statement 01 PAYMENT-KEYS. 05 IDX-PAYMENT PIC X(24). 05 IDX-P-BRANCH-ID PIC X(04). 05 FILLER PIC X(06). 05 IDX-BRANCH-PROV PIC X(02). 05 FILLER PIC X(220). >> [?21h * File Definition for RETURNS File FD RETURN-FILE BLOCK CONTAINS 8 RECORDS RECORD CONTAINS 256 CHARACTERS LABEL RECORDS STANDARD. * Define Indexes given in SELECT Statement 01 RETURN-KEYS. 05 IDX-RETURN PIC X(24). 05 IDX-R-BRANCH-ID PIC X(04). 05 IDX-RETURN-NBR PIC S9(09) COMP. 05 FILLER PIC X(224). >> [?21h FD RETURNS BLOCK CONTAINS 8 RECORDS RECORD CONTAINS 256 CHARACTERS LABEL RECORDS STANDARD. 01 RETURNS-FILE. 05 FILLER PIC X(10). 05 IDX-RETURN-NBR PIC S9(11) COMP-3. 05 IDX-BRANCH-ID PIC X(04). 05 IDX-RETURN-DATE PIC S9(09) COMP. 05 FILLER PIC S9(11) COMP-3. 05 FILLER PIC X(228). >> [?21h * File Definition for SALES-TRANSACTION File FD SALES-FILE BLOCK CONTAINS 8 RECORDS RECORD CONTAINS 256 CHARACTERS LABEL RECORDS STANDARD. * Define Indexes given in SELECT statement 01 SALES-KEYS. 05 IDX-SALES PIC X(24). 05 IDX-BRANCH-ID PIC X(04). 05 FILLER PIC X(228). >> [?21h FD SEARTONS-WORK BLOCK CONTAINS 8 RECORDS RECORD CONTAINS 256 CHARACTERS LABEL RECORDS STANDARD. 01 SEARTONS-WORK-FILE PIC X(256). >> [?21h GET-REPORT-MONTH. ACCEPT REPORT-MONTH LINE 9 COLUMN 53 PROTECTED WITH AUTOTERMINATE WITH CONVERSION DEFAULT IS CURRENT VALUE. IF REPORT-MONTH < 1 OR REPORT-MONTH > 12 THEN MOVE "N" TO GO-FLAG DISPLAY "Invalid Month Entered, Must be from 1-12" LINE 22 COLUMN 10 ELSE MOVE "Y" TO GO-FLAG DISPLAY SPACES LINE 22 ERASE TO END OF LINE END-IF. GET-REPORT-DAY. ACCEPT REPORT-DAY LINE 9 COLUMN 56 PROTECTED WITH AUTOTERMINATE WITH CONVERSION DEFAULT IS CURRENT VALUE. EVALUATE REPORT-MONTH WHEN 1 PERFORM CHECK-31-DAYS WHEN 3 PERFORM CHECK-31-DAYS WHEN 5 PERFORM CHECK-31-DAYS WHEN 7 PERFORM CHECK-31-DAYS WHEN 8 PERFORM CHECK-31-DAYS WHEN 10 PERFORM CHECK-31-DAYS WHEN 12 PERFORM CHECK-31-DAYS WHEN 4 PERFORM CHECK-30-DAYS WHEN 6 PERFORM CHECK-30-DAYS WHEN 9 PERFORM CHECK-30-DAYS WHEN 11 PERFORM CHECK-30-DAYS WHEN 2 PERFORM CHECK-QUEER-MONTH END-EVALUATE. CHECK-QUEER-MONTH. COMPUTE SPEC-LEAP-YEAR = (FUNCTION MOD (REPORT-YEAR - 1600, 4)). IF SPEC-LEAP-YEAR NOT EQUAL ZERO THEN PERFORM CHECK-28-DAYS ELSE PERFORM CHECK-29-DAYS END-IF. CHECK-28-DAYS. IF REPORT-DAY < 1 OR REPORT-DAY > 28 THEN MOVE "N" TO GO-FLAG DISPLAY "Invalid number of days in month entered" LINE 22 COLUMN 10 ELSE MOVE "Y" TO GO-FLAG DISPLAY SPACES LINE 22 ERASE TO END OF LINE END-IF. CHECK-29-DAYS. IF REPORT-DAY < 1 OR REPORT-DAY > 29 THEN MOVE "N" TO GO-FLAG DISPLAY "Invalid number of days in month entered" LINE 22 COLUMN 10 ELSE MOVE "Y" TO GO-FLAG DISPLAY SPACES LINE 22 ERASE TO END OF LINE END-IF. CHECK-31-DAYS. IF REPORT-DAY < 1 OR REPORT-DAY > 31 THEN MOVE "N" TO GO-FLAG DISPLAY "Invalid number of days in month entered" LINE 22 COLUMN 10 ELSE MOVE "Y" TO GO-FLAG DISPLAY SPACES LINE 22 ERASE TO END OF LINE END-IF. CHECK-30-DAYS. IF REPORT-DAY < 1 OR REPORT-DAY > 30 THEN MOVE "N" TO GO-FLAG DISPLAY "Invalid number of days in month entered" LINE 22 COLUMN 10 ELSE MOVE "Y" TO GO-FLAG DISPLAY SPACES LINE 22 ERASE TO END OF LINE END-IF. >> [?21h PRINT-INACTIVE-LETTER. MOVE POSTAL-CODE TO W-POSTAL-CODE. STRING PRIMARY-FIRST-NAME DELIMITED BY SPACE, ' ', PRIMARY-LAST-NAME DELIMITED BY SIZE INTO PRIMARY-NAME. MOVE PRIMARY-NAME TO WHOAMIGREETING. MOVE PRIMARY-NAME TO PRIMARY-HOLDER. STRING THE-GREETING DELIMITED BY SIZE, ' ', PRIMARY-NAME, ',' DELIMITED BY ' ' INTO WHOAMIGREETING. MOVE ACCOUNT-ID TO ACCOUNT-NBR2. MOVE STREET TO STREET-ADDRESS. STRING CITY DELIMITED BY ' ', ', ', PROVINCE, ' ' DELIMITED BY SIZE POSTAL-ONE, ' ' DELIMITED BY SIZE POSTAL-TWO DELIMITED BY SIZE INTO APPLICANT-ADDRESS. WRITE PRINT-LINE FROM MAIN-TITLE AFTER ADVANCING PAGE. WRITE PRINT-LINE FROM MAIN-STREET-ADDRESS AFTER ADVANCING 2 LINES. WRITE PRINT-LINE FROM MAIN-LOCATION AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM APPLICANT-NAME AFTER ADVANCING 7 LINES. WRITE PRINT-LINE FROM APPLICANT-STREET AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM APPLICANT-LOCATION AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM WHAT-ABOUT AFTER ADVANCING 2 LINES. WRITE PRINT-LINE FROM CARD-HOLDER AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM SEPERATOR-LINE AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM GREETING AFTER ADVANCING 2 LINES. WRITE PRINT-LINE FROM LETTER-LINE1 AFTER ADVANCING 2 LINES. WRITE PRINT-LINE FROM LETTER-LINE2 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM LETTER-LINE3 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM LETTER-LINE4 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM LETTER-LINE5 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM LETTER-LINE6 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM LETTER-LINE7 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM LETTER-LINE8 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM LETTER-LINE9 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM LETTER-LINE10 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM LETTER-LINE11 AFTER ADVANCING 1 LINE. WRITE PRINT-LINE FROM SEPERATOR-LINE AFTER ADVANCING 21 LINES. >> [?21h 01 W-POSTAL-CODE. 05 POSTAL-ONE PIC X(03). 05 POSTAL-TWO PIC X(03). 01 MAIN-TITLE. 05 FILLER PIC X(10) VALUE SPACES. 05 FILLER PIC X(08) VALUE "SEARTONS". 01 MAIN-STREET-ADDRESS. 05 FILLER PIC X(15) VALUE SPACES. 05 FILLER PIC X(11) VALUE "123 Main St". 01 MAIN-LOCATION. 05 FILLER PIC X(15) VALUE SPACES. 05 FILLER PIC X(21) VALUE "Halifax, N.S. R3Y 7U8". 01 CARD-HOLDER. 05 FILLER PIC X(10) VALUE SPACES. 05 SUPP-TITLE3 PIC X(21) VALUE "Primary Card Holder: ". 05 PRIMARY-HOLDER PIC X(30). 05 SUPP-TITLE4 PIC X(09) VALUE "Account: ". 05 ACCOUNT-NBR2 PIC X(10). 01 WHAT-ABOUT. 05 FILLER PIC X(58) VALUE SPACES. 05 SUPP-TITLE4 PIC X(22) VALUE "Seartons Questionnaire". 01 APPLICANT-NAME. 05 FILLER PIC X(15). 05 PRIMARY-NAME PIC X(32). 01 APPLICANT-STREET. 05 FILLER PIC X(15). 05 STREET-ADDRESS PIC X(18). 01 APPLICANT-LOCATION. 05 FILLER PIC X(15) VALUE SPACES. 05 APPLICANT-ADDRESS PIC X(30). 01 OUTSIDE-BORDER PIC X(80) VALUE "_____________________________________________________________________ ___________". 01 SEPERATOR-LINE. 05 FILLER PIC X(10) VALUE SPACES. 05 FILLER PIC X(70) VALUE "-------------------------- --------------------------------------------". 05 THE-GREETING PIC X(05) VALUE "Dear". 01 GREETING. 05 FILLER PIC X(10) VALUE SPACES. 05 WHOAMIGREETING PIC X(37). 01 LETTER-LINE1. 05 FILLER PIC X(15) VALUE SPACES. 05 LINE1 PIC X(65) VALUE "We are sending you this questionnaire because you have not used". 01 LETTER-LINE2. 05 FILLER PIC X(10). 05 LINE2 PIC X(70) VALUE "your Searton's credit card in the last three months. We are just ". 01 LETTER-LINE3. 05 FILLER PIC X(10). 05 LINE3 PIC X(70) VALUE "wondering why you are not using it. This letter does not mean th at ". 01 LETTER-LINE4. 05 FILLER PIC X(10). 05 LINE4 PIC X(70) VALUE "we have cancelled your account, nor does failing to return the ". 01 LETTER-LINE5. 05 FILLER PIC X(10). 05 LINE5 PIC X(70) VALUE "questionnaire mean that we will cancel your account. We are just ". 01 LETTER-LINE6. 05 FILLER PIC X(10). 05 LINE6 PIC X(70) VALUE "concerned that we are not meeting your needs and would like to". 01 LETTER-LINE7. 05 FILLER PIC X(10). 05 LINE7 PIC X(70) VALUE "have some input into what we can do to change that. Enclosed ". 01 LETTER-LINE8. 05 FILLER PIC X(10). 05 LINE8 PIC X(70) VALUE "is a short questionnaire which will ask you a few simple". 01 LETTER-LINE9. 05 FILLER PIC X(10). 05 LINE9 PIC X(70) VALUE "questions. Just put the questionnaire into the enclosed postage" . 01 LETTER-LINE10. 05 FILLER PIC X(10). 05 LINE10 PIC X(70) VALUE "paid envelope and mail. That is all you have to do. Thank you " . 01 LETTER-LINE11. 05 FILLER PIC X(10). 05 LINE11 PIC X(70) VALUE "in advance for your input. " . >> [?21h * COBOL system call to retrieve current date & time * Property of whoever thought up this command -- Probably someone at DEC MOVE FUNCTION CURRENT-DATE TO SYS-DATE-TIME. >> [?21h * Checks Character Fields for Invalid Characters and Leading Spaces JUNK-CHECK. INITIALIZE JUNK-COUNTER. INSPECT V-TEST-FIELD TALLYING JUNK-COUNTER FOR LEADING SPACES * Allowable Characters other than Alphabetic Characters and Non-Leading Spaces REPLACING ALL "." BY SPACE "," BY SPACE "-" BY SPACE "'" BY SPACE. IF V-TEST-FIELD IS NOT ALPHABETIC OR JUNK-COUNTER NOT EQUAL ZEROS THEN MOVE "Y" TO JUNK-FLAG ELSE DISPLAY SPACES LINE 22 ERASE TO END OF LINE MOVE "N" TO JUNK-FLAG END-IF. >> [?21h GET-LANGUAGE-CODE. PERFORM CLEAR-20. DISPLAY "Enter Preferred Language: (E)nglish, (F)rench or (S)panish" LINE 20 COLUMN 10. ACCEPT O-LANG-CODE LINE 12 COLUMN 66 PROTECTED WITH AUTOTERMINATE WITH NO BLANK DEFAULT IS CURRENT VALUE. INSPECT O-LANG-CODE CONVERTING LOWER-CASE TO UPPER-CASE. DISPLAY O-LANG-CODE LINE 12 COLUMN 66. IF NOT VALID-CODES THEN MOVE "N" TO GO-FLAG DISPLAY "Enter a Language Code (E, F or S)" LINE 22 COLUMN 20 ELSE MOVE "Y" TO GO-FLAG DISPLAY SPACES LINE 22 ERASE TO END OF LINE MOVE O-LANG-CODE TO LANG-CODE END-IF. >> [?21h * This copy library is used to store a record that is read from * the Payment Transaction File 01 PAYMENT-READ-IN. 05 PAYMENT-KEY. 10 P-ACCOUNT-ID PIC X(10). 10 PAYMENT-DATE PIC X(08). 10 PAYMENT-TIME PIC X(06). 05 P-BRANCH-ID PIC X(04). 05 PAYMENT-TYPE PIC X(02). 05 REFERENCE-ID PIC X(04). 05 BRANCH-PROV PIC X(02). 05 PAYMENT-AMT PIC S9(11) COMP-3. 05 FILLER PIC X(214). >> [?21h GET-HOME-PHONE. PERFORM CLEAR-20. DISPLAY "Enter Area Code" LINE 20 COLUMN 10. MOVE "N" TO GO-FLAG. PERFORM GET-H-AREA-CODE UNTIL OKAY. PERFORM CLEAR-20. DISPLAY "Enter Exchange" LINE 20 COLUMN 10. MOVE "N" TO GO-FLAG. PERFORM GET-H-EXTENSION UNTIL OKAY. PERFORM CLEAR-20. DISPLAY "Enter Number" LINE 20 COLUMN 10. MOVE "N" TO GO-FLAG. PERFORM GET-H-NUMBER UNTIL OKAY. MOVE O-HOME-PHONE TO F-HOME-PHONE. MOVE F-HOME-PHONE TO HOME-PHONE. GET-H-AREA-CODE. ACCEPT H-AREA-CODE LINE 11 COLUMN 22 PROTECTED WITH AUTOTERMINATE DEFAULT SPACES. IF H-AREA-CODE IS NOT NUMERIC THEN MOVE "N" TO GO-FLAG DISPLAY "Invalid Character Entered" LINE 22 COLUMN 20 ELSE MOVE "Y" TO GO-FLAG DISPLAY SPACES LINE 22 ERASE TO END OF LINE END-IF. GET-H-EXTENSION. ACCEPT H-EXTENSION LINE 11 COLUMN 27 PROTECTED WITH AUTOTERMINATE DEFAULT SPACES. IF H-EXTENSION NOT NUMERIC MOVE "N" TO GO-FLAG DISPLAY "Invalid Character Entered" LINE 22 COLUMN 20 ELSE MOVE "Y" TO GO-FLAG DISPLAY SPACES LINE 22 ERASE TO END OF LINE END-IF. GET-H-NUMBER. ACCEPT H-NUMBER LINE 11 COLUMN 31 PROTECTED WITH AUTOTERMINATE DEFAULT SPACES. IF H-NUMBER IS NOT NUMERIC THEN MOVE "N" TO GO-FLAG DISPLAY "Invalid Character Entered" LINE 22 COLUMN 20 ELSE MOVE "Y" TO GO-FLAG DISPLAY SPACES LINE 22 ERASE TO END OF LINE END-IF. GET-WORK-PHONE. PERFORM CLEAR-20. DISPLAY "Enter Area Code" LINE 20 COLUMN 10. MOVE "N" TO GO-FLAG. PERFORM GET-W-AREA-CODE UNTIL OKAY. PERFORM CLEAR-20. DISPLAY "Enter Exchange" LINE 20 COLUMN 10. MOVE "N" TO GO-FLAG. PERFORM GET-W-EXTENSION UNTIL OKAY. PERFORM CLEAR-20. DISPLAY "Enter Number" LINE 20 COLUMN 10. MOVE "N" TO GO-FLAG. PERFORM GET-W-NUMBER UNTIL OKAY. MOVE O-WORK-PHONE TO F-WORK-PHONE. MOVE F-WORK-PHONE TO WORK-PHONE. GET-W-AREA-CODE. ACCEPT W-AREA-CODE LINE 12 COLUMN 22 PROTECTED WITH AUTOTERMINATE DEFAULT IS H-AREA-CODE. DISPLAY W-AREA-CODE LINE 12 COLUMN 22. IF W-AREA-CODE IS NOT NUMERI