PROGRAM 4

PROGRAM 4 IDENTIFICATION DIVISION. PROGRAM-ID. PROJECT4. AUTHOR. ANTHONY F. ORTIZ. ******************************************* * THIS PROGRAM CREATES A CREDIT REPORT. * ******************************************* ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT IN-FILE ASSIGN TO DISK "TWO.DAT" ORGANIZATION IS LINE SEQUENTIAL. SELECT OUT-FILE ASSIGN TO PRINTER. DATA DIVISION. FILE SECTION. FD IN-FILE LABEL RECORD IS STANDARD. 01 IN-RECORD. 02 FILLER PIC X(6). 02 IN-ACCOUNT-NUMBER PIC 9(6). 02 IN-CUSTOMER-NAME PIC X(20). 02 FILLER PIC X(21). 02 IN-BALANCE PIC 9(4)V99. 02 IN-PURCHASES PIC 9(4)V99. 02 FILLER PIC X(2). FD OUT-FILE. 01 OUT-BUFFER PIC X(80). WORKING-STORAGE SECTION. 01 OUT-RECORD. 02 OUT-ACCOUNT-NUMBER PIC ZZZZZ9. 02 FILLER PIC X(6). 02 OUT-CUSTOMER-NAME PIC X(20). 02 FILLER PIC X(4). 02 OUT-BALANCE PIC Z,ZZZ.99. 02 FILLER PIC X(4). 02 OUT-PURCHASES PIC Z,ZZZ.99. 02 FILLER PIC X(4). 02 OUT-LIMIT PIC Z,ZZZ.99. 02 FILLER PIC X(3). 02 OUT-CREDIT PIC $$,$$$.99. 01 HEADER-LINE. 02 FILLER PIC X(6) VALUE 'NUMBER'. 02 FILLER PIC X(14) VALUE SPACES. 02 FILLER PIC X(4) VALUE 'NAME'. 02 FILLER PIC X(13) VALUE SPACES. 02 FILLER PIC X(7) VALUE 'BALANCE'. 02 FILLER PIC X(3) VALUE SPACES. 02 FILLER PIC X(9) VALUE 'PURCHASES'. 02 FILLER PIC X(5) VALUE SPACES. 02 FILLER PIC X(5) VALUE 'LIMIT'. 02 FILLER PIC X(7) VALUE SPACES. 02 FILLER PIC X(6) VALUE 'CREDIT'. 01 PROGRAM-INDICATORS. 02 EOF-SWITCH PIC X(3) VALUE 'NO '. 01 PROGRAM-CONSTANTS. 02 LIMIT-CONSTANT PIC 9(4)V99 VALUE 1500. 01 CREDIT PIC 9(5)V99 VALUE 0. 01 COUNTER PIC 9(2) VALUE 0. PROCEDURE DIVISION. MAIN-LINE. PERFORM OPEN-FILES. PERFORM PRINT-TITLE. PERFORM READ-RECORD. PERFORM PRINT-RECORD UNTIL EOF-SWITCH = 'YES'. PERFORM CLOSE-FILES. STOP RUN. OPEN-FILES. OPEN INPUT IN-FILE OUTPUT OUT-FILE. PRINT-TITLE. WRITE OUT-BUFFER FROM HEADER-LINE AFTER ADVANCING PAGE. READ-RECORD. READ IN-FILE AT END MOVE 'YES' TO EOF-SWITCH. PRINT-RECORD. PERFORM MOVE-IN-TO-OUT. PERFORM WRITE-RECORD. PERFORM READ-RECORD. MOVE-IN-TO-OUT. MOVE IN-ACCOUNT-NUMBER TO OUT-ACCOUNT-NUMBER. MOVE IN-CUSTOMER-NAME TO OUT-CUSTOMER-NAME. MOVE IN-BALANCE TO OUT-BALANCE. MOVE IN-PURCHASES TO OUT-PURCHASES. PERFORM CALCULATE-CREDIT. MOVE LIMIT-CONSTANT TO OUT-LIMIT. MOVE CREDIT TO OUT-CREDIT. PERFORM ADD-COUNTER. CALCULATE-CREDIT. COMPUTE CREDIT = LIMIT-CONSTANT - IN-BALANCE - IN-PURCHASES. ADD-COUNTER. COMPUTE COUNTER = COUNTER + 1. IF COUNTER = 27 PERFORM PRINT-TITLE COMPUTE COUNTER = 0. WRITE-RECORD. WRITE OUT-BUFFER FROM OUT-RECORD AFTER ADVANCING 2 LINES. CLOSE-FILES. CLOSE IN-FILE OUT-FILE. * DATA FILE: TWO.DAT * 072786100101ALBERT, PETER A. CRT WORKSTATION 101202100308901 072786100103ALLENSON, SHEILA M. CONTEMPORARY DESK 202386800873403 072786100105ANDERSON, ARLENE T. EXECUTIVE DESK CHAIR301259301005005 072786100107BILLINGS, BARBARA ARMLESS SWIVEL CHAIR401378301105606 072786100109CANNON, CAROLE C. PLASTICMAID FLOORMAT200673900300004 072786100310CHAPMAN, RONA L. HAT & COAT RACK 301569400356702 072786100312CLAFFLIN, WALTER E. 5 DRAWER CABINET 401250100367803 072786100313COMPANA, ESTER CRT STAND & PAD 101890100789576 072786100315COOPER, BART B. CORRUGATED ORGANIZER100456700200034 072786100316CRAIGS, ELAINE 5" MESSAGE PADS 100127300506785 072786100318DOGGING, CARL LABEL & BADGE MAKER 301345700240582 072886100529DOWNING, EARLE S. SELF-ADHISIVE LABELS304873101258991 072886100530DRIFT, CHRISTOPHER #14 RUBBER BANDS 200053700348446 072886100531ERIKSON, BRIT E. TRANSPARENT TAPE 402345601103406 072886100532FREEMAN, ROBERT F. PHONE/ADDRESS BOOK 200579300608034 072886100535FRONT, CHARLES L. ELMO'S SUPER GLUE 401457300293483 072886100537GARCIA, JOSE FLOWCHART TEMPLATE 201456301013442 072886100738HATFIELD, FRED R. EXPAND-O FILE FOLDER403568500806795 072886100739HELLER, KAREN S. DESK TOP CARD FILE 300456700304591 072886100740HENDRIX, SHIRLEY D. GENERAL LEDGER CARDS300348200169523 072886100742ISLANDER, JENNE WOOD ATTACHE CASE 203547801209865 072886100743LADA, LAWRENCE S. STANDARD STAPLES 104500802475332 072886100745LADD, DAVID L. MULTIPLE HOLE PUNCH 400346800204082 072886100947LAMB, EDWARD R. PRESENTATION EASELS 203984402879906 072886100948LEELAND, WESLEY R. MAGNIFYING GLASS 300738300607023 072986100949LOFTIS, DOUGLAS L. DESK PAD & CALENDAR 100783700500092 072986100950MILLER, SUSAN S. DESK TOP ORGANIZER 203759802184392 072986200151MUDGLEY, BRENDA 3' DESK LAMP 203568401568224 072986200152NICKELS, KATHY WALL CLOCK & CORD 210308804108071 072986200154NOWAKOWSKI, ALLEN T.WASTE RECEPTICLES 403459300809545 072986200355PATERSON, PATTI SMOKING STANDS 108906701293424 072986200356PETERSON, JACK E. CORRESPONDONCE FORM 403450900809693 072986200357PETERSON, TONY L. WORK ORDER FORM PADS212009900459875 072986200358PLANTARA, CARLA P. PRESSBOARD COVERS 406550900879336 073086200359RASKIN, RUTH E. METAL HINGE BINDERS 309833104658262 073086200560SANDERSON, PAULETTE STENOGRAPHER'S PAD 412569300308551 073086200562SAUNDERS, GEORGE P. BINDER INDEXES 204050603459843 073086200564SINGER, ALEXIS E. EXPENSE BOOKLET 300348500203484 073086200565SUMMERS, APRIL L. COLUMNAR BOOKS 407890104593056 073086200567SWEET, SUSAN R. CALCULATOR ROLLS 109345405056091 073086200769TANDY, TRICIA S. HAND HELD CALCULATOR208394505010003 073086200770TERRY, RON CATCH-A-CALL PHONE 308309204832296 073186200773TONEY, IRA L. PENCIL SHARPENER 408398904007082 073186200775UPLAND, JILL I. PEN & PENCIL SET 208987803567754 073186200779VANBUREN, ERIN F. MECHANICAL PENCIL 304354403234735 073186200980WALLACE, STEVEN COLORED PENCIL SET 208979903478541 073186200985WALTON, WOODROW R. DUPLICATING FLUID 400783900638363 073186200987YULANE, ARTHUR M. FILING ENVELOPES 301234500900045 073186200990ZIPPO, WANDA EXECUTIVE PAD HOLDER400847500739156 073186200995ZOONEY, MARVIN 5" DISKETTE HOLDER 109385505033253 * OUTFILE: PROG4.OUT * NUMBER NAME BALANCE PURCHASES LIMIT CREDIT 100101 ALBERT, PETER A. 120.21 30.89 1,500.00 $1,348.90 100103 ALLENSON, SHEILA M. 238.68 87.34 1,500.00 $1,173.98 100105 ANDERSON, ARLENE T. 125.93 100.50 1,500.00 $1,273.57 100107 BILLINGS, BARBARA 137.83 110.56 1,500.00 $1,251.61 100109 CANNON, CAROLE C. 67.39 30.00 1,500.00 $1,402.61 100310 CHAPMAN, RONA L. 156.94 35.67 1,500.00 $1,307.39 100312 CLAFFLIN, WALTER E. 125.01 36.78 1,500.00 $1,338.21 100313 COMPANA, ESTER 189.01 78.95 1,500.00 $1,232.04 100315 COOPER, BART B. 45.67 20.00 1,500.00 $1,434.33 100316 CRAIGS, ELAINE 12.73 50.67 1,500.00 $1,436.60 100318 DOGGING, CARL 134.57 24.05 1,500.00 $1,341.38 100529 DOWNING, EARLE S. 487.31 125.89 1,500.00 $886.80 100530 DRIFT, CHRISTOPHER 5.37 34.84 1,500.00 $1,459.79 100531 ERIKSON, BRIT E. 234.56 110.34 1,500.00 $1,155.10 100532 FREEMAN, ROBERT F. 57.93 60.80 1,500.00 $1,381.27 100535 FRONT, CHARLES L. 145.73 29.34 1,500.00 $1,324.93 100537 GARCIA, JOSE 145.63 101.34 1,500.00 $1,253.03 100738 HATFIELD, FRED R. 356.85 80.67 1,500.00 $1,062.48 100739 HELLER, KAREN S. 45.67 30.45 1,500.00 $1,423.88 100740 HENDRIX, SHIRLEY D. 34.82 16.95 1,500.00 $1,448.23 100742 ISLANDER, JENNE 354.78 120.98 1,500.00 $1,024.24 100743 LADA, LAWRENCE S. 450.08 247.53 1,500.00 $802.39 100745 LADD, DAVID L. 34.68 20.40 1,500.00 $1,444.92 100947 LAMB, EDWARD R. 398.44 287.99 1,500.00 $813.57 100948 LEELAND, WESLEY R. 73.83 60.70 1,500.00 $1,365.47 100949 LOFTIS, DOUGLAS L. 78.37 50.00 1,500.00 $1,371.63 NUMBER NAME BALANCE PURCHASES LIMIT CREDIT 100950 MILLER, SUSAN S. 375.98 218.43 1,500.00 $905.59 200151 MUDGLEY, BRENDA 356.84 156.82 1,500.00 $986.34 200152 NICKELS, KATHY 1,030.88 410.80 1,500.00 $58.32 200154 NOWAKOWSKI, ALLEN T. 345.93 80.95 1,500.00 $1,073.12 200355 PATERSON, PATTI 890.67 129.34 1,500.00 $479.99 200356 PETERSON, JACK E. 345.09 80.96 1,500.00 $1,073.95 200357 PETERSON, TONY L. 1,200.99 45.98 1,500.00 $253.03 200358 PLANTARA, CARLA P. 655.09 87.93 1,500.00 $756.98 200359 RASKIN, RUTH E. 983.31 465.82 1,500.00 $50.87 200560 SANDERSON, PAULETTE 1,256.93 30.85 1,500.00 $212.22 200562 SAUNDERS, GEORGE P. 405.06 345.98 1,500.00 $748.96 200564 SINGER, ALEXIS E. 34.85 20.34 1,500.00 $1,444.81 200565 SUMMERS, APRIL L. 789.01 459.30 1,500.00 $251.69 200567 SWEET, SUSAN R. 934.54 505.60 1,500.00 $59.86 200769 TANDY, TRICIA S. 839.45 501.00 1,500.00 $159.55 200770 TERRY, RON 830.92 483.22 1,500.00 $185.86 200773 TONEY, IRA L. 839.89 400.70 1,500.00 $259.41 200775 UPLAND, JILL I. 898.78 356.77 1,500.00 $244.45 200779 VANBUREN, ERIN F. 435.44 323.47 1,500.00 $741.09 200980 WALLACE, STEVEN 897.99 347.85 1,500.00 $254.16 200985 WALTON, WOODROW R. 78.39 63.83 1,500.00 $1,357.78 200987 YULANE, ARTHUR M. 123.45 90.00 1,500.00 $1,286.55 200990 ZIPPO, WANDA 84.75 73.91 1,500.00 $1,341.34 200995 ZOONEY, MARVIN 938.55 503.32 1,500.00 $58.13 BACK TO CIS165 PAGE.