//IBMUSERX JOB NOTIFY=&SYSUID 00010000

//STEP1 EXEC PGM=ACCTPGM1 00020000

//STEPLIB DD DSN=IBMUSER.T5.LOAD,DISP=SHR 00030000
//SYSPRINT DD SYSOUT=* 00040000
//SYSOUT DD SYSOUT=* 00050000
//ACCTDD01 DD DSN=IBMUSER.T5.ACCT.FILE,DISP=(NEW,CATLG,DELETE), 00060000
// UNIT=3390,VOL=SER=JASYS1, 00070000
// SPACE=(TRK,(1,1),RLSE), 00080000
// DSORG=PS,LRECL=30,RECFM=FB,BLKSIZE=0 00090000
//SYSIN DD * 00100000
S1111 00110000
ANIL KUMAR 00120000
10000 00130000
SAVINGS 00140000
Y 00150000
S1111 00151002
ANIL KUMAR 00152000
10000 00153000
SAVINGS 00154002
Y 00155000
C1111 00156000
ANIL KUMAR 00157000
10000 00158000
CURRENT 00159002
Y 00159100
C1111 00159202
ANIL KUMAR 00159300
10000 00159400
CURRENT 00159502
N 00159600
/* 00160000
// 00170000
//IBMUSERX JOB NOTIFY=&SYSUID 00010000
//STEP1 EXEC PGM=ACCTPGM2 00020000
//STEPLIB DD DSN=IBMUSER.T5.LOAD,DISP=SHR 00030000
//SYSPRINT DD SYSOUT=* 00040000
//SYSOUT DD SYSOUT=* 00050000
//ACCTDDIN DD DSN=IBMUSER.T5.ACCT.FILE,DISP=SHR 00060000
//SAVEDDOT DD DSN=IBMUSER.T5.SAVE.FILE,DISP=(NEW,CATLG,DELETE), 00070000
// UNIT=3390,VOL=SER=JASYS1, 00080000
// SPACE=(TRK,(2,2),RLSE), 00090000
// DSORG=PS,LRECL=30,RECFM=FB,BLKSIZE=0 00100000
//CURRDDOT DD DSN=IBMUSER.T5.CURR.FILE,DISP=(NEW,CATLG,DELETE), 00101000
// UNIT=3390,VOL=SER=JASYS1, 00102000
// SPACE=(TRK,(2,2),RLSE), 00103000
// DSORG=PS,LRECL=30,RECFM=FB,BLKSIZE=0 00104000
// 00110000
ID DIVISION. 00010000
PROGRAM-ID. ACCTPGM1. 00020000
AUTHOR. NAME. 00030000
DATE-WRITTEN. TODAY. 00040000
00050000
ENVIRONMENT DIVISION. 00060000
INPUT-OUTPUT SECTION. 00070000
FILE-CONTROL. 00080000
SELECT ACCT-FILE ASSIGN TO ACCTDD01 00090000
ORGANIZATION IS SEQUENTIAL 00100000
ACCESS MODE IS SEQUENTIAL 00110000
FILE STATUS IS WS-OUTF-STATUS. 00120001
 00130000
DATA DIVISION. 00140000
FILE SECTION. 00150000
FD ACCT-FILE 00160000
LABEL RECORD ARE STANDARD. 00170000
COPY ACCTCPY1 00180002
REPLACING ACCT-DETAILS BY ACCT-DETAILS-OUT. 00230002
WORKING-STORAGE SECTION. 00240000
01 WS-OUTF-STATUS PIC X(02) VALUE SPACE. 00250001
01 ACCT-DETAILS-IN. 00260001
03 ACCT-NUMBER PIC X(05) VALUE SPACE. 00270000
03 CUST-NAME PIC X(10) VALUE SPACE. 00280000
03 ACCT-BAL PIC S9(03)V9(02) VALUE ZERO. 00290000
03 ACCT-TYPE PIC X(10) VALUE SPACE. 00300000
00310000
01 WS-ANY-MORE-INPUT PIC X(01) VALUE SPACE. 00320000
01 WS-VALID-INPUT PIC X(01) VALUE SPACE. 00330000
01 WS-IN-REC-CNT PIC 9(02) VALUE ZERO. 00340000
01 WS-OT-REC-CNT PIC 9(02) VALUE ZERO. 00350000
01 WS-ABENDPGM PIC X(08) VALUE 'ABENDPGM'. 00360000
00370000
PROCEDURE DIVISION. 00380000
000-MAIN-PARA. 00390000
DISPLAY 'ACCTPGM1 STARTED'. 00400000
00410000
PERFORM 100-INITIAL-PARA THRU 100-EXIT 00420000
PERFORM 200-GET-INPUT-PARA THRU 200-EXIT 00430000
PERFORM 300-PROCESS-PARA THRU 300-EXIT 00440000
UNTIL WS-ANY-MORE-INPUT = 'N'. 00450000
00460000
CLOSE ACCT-FILE. 00470000
DISPLAY 'TOTAL INPUT RECORD COUNT ' WS-IN-REC-CNT. 00480000
DISPLAY 'TOTAL OUTPUT RECORD COUNT ' WS-OT-REC-CNT. 00490000
STOP RUN. 00500000
00510000
100-INITIAL-PARA. 00520000
MOVE 'Y' TO WS-ANY-MORE-INPUT. 00530000
MOVE ZERO TO WS-IN-REC-CNT WS-OT-REC-CNT. 00540000
00550000
OPEN OUTPUT ACCT-FILE. 00560000
IF WS-OUTF-STATUS = '00' 00570000
CONTINUE 00580000
ELSE 00590000
DISPLAY 'ERROR IN 100-PARA' 00600000
DISPLAY 'FILE OPEN ERROR STATUS IS ' WS-OUTF-STATUS 00610000
CALL WS-ABENDPGM 00620000
END-IF. 00630000
INITIALIZE ACCT-DETAILS-IN ACCT-DETAILS-OUT. 00640000
100-EXIT. EXIT. 00650000
00660000
200-GET-INPUT-PARA. 00670000
ACCEPT ACCT-NUMBER OF ACCT-DETAILS-IN 00680000
ACCEPT CUST-NAME OF ACCT-DETAILS-IN 00690000
ACCEPT ACCT-BAL OF ACCT-DETAILS-IN 00700000
ACCEPT ACCT-TYPE OF ACCT-DETAILS-IN. 00710000
ADD +1 TO WS-IN-REC-CNT. 00720000
200-EXIT. EXIT. 00730000
00740000
300-PROCESS-PARA. 00750000
 MOVE 'Y' TO WS-VALID-INPUT. 00760000
PERFORM 310-AUDIT-INPUT-PARA THRU 310-EXIT. 00770000
00780000
IF WS-VALID-INPUT = 'Y' 00790000
PERFORM 340-MOVE-WRITE-PARA THRU 340-EXIT 00800000
END-IF. 00810000
00820000
ACCEPT WS-ANY-MORE-INPUT 00830000
IF WS-ANY-MORE-INPUT = 'Y' 00840000
PERFORM 200-GET-INPUT-PARA THRU 200-EXIT 00850000
END-IF. 00860000
300-EXIT. EXIT. 00870000
00880000
310-AUDIT-INPUT-PARA. 00890000
IF ACCT-NUMBER OF ACCT-DETAILS-IN = SPACE 00900000
MOVE 'N' TO WS-VALID-INPUT 00910000
GO TO 310-EXIT 00920000
END-IF. 00930000
00940000
IF CUST-NAME OF ACCT-DETAILS-IN = SPACE 00950000
MOVE 'N' TO WS-VALID-INPUT 00960000
GO TO 310-EXIT 00970000
END-IF. 00980000
00990000
IF ACCT-BAL OF ACCT-DETAILS-IN < 0 01000000
MOVE 'N' TO WS-VALID-INPUT 01010000
GO TO 310-EXIT 01020000
END-IF. 01030000
01040000
IF ACCT-TYPE OF ACCT-DETAILS-IN = SPACE 01050000
MOVE 'N' TO WS-VALID-INPUT 01060000
END-IF. 01080000
310-EXIT. EXIT. 01090000
01100000
340-MOVE-WRITE-PARA. 01110000
MOVE ACCT-NUMBER OF ACCT-DETAILS-IN TO 01120000
ACCT-NUMBER OF ACCT-DETAILS-OUT. 01130000
MOVE CUST-NAME OF ACCT-DETAILS-IN TO 01140000
CUST-NAME OF ACCT-DETAILS-OUT. 01150000
MOVE ACCT-BAL OF ACCT-DETAILS-IN TO 01160000
ACCT-BAL OF ACCT-DETAILS-OUT. 01170000
MOVE ACCT-TYPE OF ACCT-DETAILS-IN TO 01180000
ACCT-TYPE OF ACCT-DETAILS-OUT. 01190000
WRITE ACCT-DETAILS-OUT. 01200000
IF WS-OUTF-STATUS = '00' 01210000
ADD +1 TO WS-OT-REC-CNT 01220000
ELSE 01230000
DISPLAY 'ERORR IN 340-MOVE-WRITE-PARA' 01240000
DISPLAY 'WRITE ERROR STATUS IS ' WS-OUTF-STATUS 01250000
DISPLAY 'RECORD KEY IS' ACCT-NUMBER OF ACCT-DETAILS-IN 01260000
CALL WS-ABENDPGM 01270000
END-IF. 01280000
340-EXIT. EXIT. 01290000
ID DIVISION. 00010000
PROGRAM-ID. ACCTPGM2. 00020002
AUTHOR. NAME. 00030000
DATE-WRITTEN. TODAY. 00040000
00050000
ENVIRONMENT DIVISION. 00060000
INPUT-OUTPUT SECTION. 00070000
FILE-CONTROL. 00080000
SELECT ACCT-INFILE ASSIGN TO ACCTDDIN 00090002
ORGANIZATION IS SEQUENTIAL 00100000
ACCESS MODE IS SEQUENTIAL 00110000
FILE STATUS IS WS-INF-STATUS. 00120002
00130000
SELECT SAVE-OTFILE ASSIGN TO SAVEDDOT 00131002
ORGANIZATION IS SEQUENTIAL 00132002
ACCESS MODE IS SEQUENTIAL 00133002
FILE STATUS IS WS-SAF-STATUS. 00134002
00135002
SELECT CURR-OTFILE ASSIGN TO CURRDDOT 00136002
ORGANIZATION IS SEQUENTIAL 00137002
ACCESS MODE IS SEQUENTIAL 00138002
FILE STATUS IS WS-CUF-STATUS. 00139002
00139102
DATA DIVISION. 00140000
FILE SECTION. 00150000
FD ACCT-INFILE 00160002
LABEL RECORD ARE STANDARD. 00170000
COPY ACCTCPY1 00180008
REPLACING ACCT-DETAILS BY ACCT-DETAILS-IN. 00190008
00230000
FD SAVE-OTFILE 00231002
LABEL RECORD ARE STANDARD. 00232002
COPY ACCTCPY1 00233008
REPLACING ACCT-DETAILS BY SAVE-DETAILS-OT. 00234008
00238002
FD CURR-OTFILE 00239002
LABEL RECORD ARE STANDARD. 00239102
COPY ACCTCPY1 00239208
REPLACING ACCT-DETAILS BY CURR-DETAILS-OT. 00239308
00239707
WORKING-STORAGE SECTION. 00240000
01 WS-INF-STATUS PIC X(02) VALUE SPACE. 00310002
01 WS-SAF-STATUS PIC X(02) VALUE SPACE. 00311002
01 WS-CUF-STATUS PIC X(02) VALUE SPACE. 00312002
01 WS-IN-REC-CNT PIC 9(02) VALUE ZERO. 00360001
01 WS-OT-REC-CNT PIC 9(02) VALUE ZERO. 00370001
01 WS-ABENDPGM PIC X(08) VALUE 'ABENDPGM'. 00400000
00401002
01 WS-END-OF-FILE PIC X(01) VALUE SPACE. 00402002
01 WS-TOT-ACCT-BAL PIC S9(3)V9(02) VALUE ZERO. 00403002
01 WS-TOT-SAVE-BAL PIC S9(3)V9(02) VALUE ZERO. 00404002
01 WS-TOT-CURR-BAL PIC S9(3)V9(02) VALUE ZERO. 00405002
00410000
PROCEDURE DIVISION. 00420000
0000-MAIN-PARA. 00430000
DISPLAY 'ACCTPGM2 STARTED'. 00440002
00450000
PERFORM 100-INITIAL-PARA THRU 100-EXIT 00460000
PERFORM 200-GET-INPUT-PARA THRU 200-EXIT 00470000
PERFORM 300-PROCESS-PARA THRU 300-EXIT 00480000
UNTIL WS-END-OF-FILE = 'Y'. 00490002
00500000
CLOSE ACCT-INFILE SAVE-OTFILE CURR-OTFILE. 00510002
DISPLAY 'TOTAL ACCT BALANCE IS ' WS-TOT-ACCT-BAL. 00520002
DISPLAY 'TOTAL SAVE BALANCE IS ' WS-TOT-SAVE-BAL. 00520102
 DISPLAY 'TOTAL CURR BALANCE IS ' WS-TOT-CURR-BAL. 00520202
00520302
DISPLAY 'TOTAL INPUT REC COUNT ' WS-IN-REC-CNT. 00521002
DISPLAY 'TOTAL OUTPUT REC COUNT ' WS-OT-REC-CNT. 00530000
STOP RUN. 00540000
00550000
100-INITIAL-PARA. 00560000
MOVE ZERO TO WS-IN-REC-CNT 00570000
WS-OT-REC-CNT 00580002
WS-TOT-ACCT-BAL 00580102
WS-TOT-SAVE-BAL 00580202
WS-TOT-CURR-BAL. 00581002
00590000
MOVE 'N' TO WS-END-OF-FILE. 00600002
00610000
OPEN INPUT ACCT-INFILE. 00620002
OPEN OUTPUT SAVE-OTFILE CURR-OTFILE. 00621002
IF WS-INF-STATUS = '00' 00630002
CONTINUE 00640000
ELSE 00650000
DISPLAY 'ERROR IN 100-PARA' 00660000
DISPLAY 'OPEN ERROR - ACCT STATUS IS ' WS-INF-STATUS 00670002
CALL WS-ABENDPGM 00680000
END-IF. 00690000
IF WS-SAF-STATUS = '00' 00691002
CONTINUE 00692002
ELSE 00693002
DISPLAY 'ERROR IN 100-PARA' 00694002
DISPLAY 'OPEN ERROR - SAVE STATUS IS ' WS-SAF-STATUS 00695002
CALL WS-ABENDPGM 00696002
END-IF. 00697002
IF WS-CUF-STATUS = '00' 00698002
CONTINUE 00699002
ELSE 00699102
DISPLAY 'ERROR IN 100-PARA' 00699202
DISPLAY 'OPEN ERROR - CURR STATUS IS ' WS-CUF-STATUS 00699302
CALL WS-ABENDPGM 00699402
END-IF. 00699502
INITIALIZE ACCT-DETAILS-IN SAVE-DETAILS-OT. 00700002
INITIALIZE CURR-DETAILS-OT. 00701002
100-EXIT. EXIT. 00710000
00720000
200-GET-INPUT-PARA. 00730000
READ ACCT-INFILE 00740002
AT END 00750002
MOVE 'Y' TO WS-END-OF-FILE 00760002
GO TO 200-EXIT. 00770002
00771002
ADD +1 TO WS-IN-REC-CNT. 00780000
200-EXIT. EXIT. 00790000
00800000
300-PROCESS-PARA. 00810000
COMPUTE WS-TOT-ACCT-BAL = WS-TOT-ACCT-BAL + 00811004
ACCT-BAL OF ACCT-DETAILS-IN. 00812004
00813004
IF ACCT-TYPE OF ACCT-DETAILS-IN = 'SAVINGS' 00820003
COMPUTE WS-TOT-SAVE-BAL = WS-TOT-SAVE-BAL + 00821004
ACCT-BAL OF ACCT-DETAILS-IN 00822004
PERFORM 320-MOVE-WRITE-SAVE-PARA THRU 320-EXIT 00830002
 ELSE 00840002
IF ACCT-TYPE OF ACCT-DETAILS-IN = 'CURRENT' 00850002
COMPUTE WS-TOT-CURR-BAL = WS-TOT-CURR-BAL + 00851004
ACCT-BAL OF ACCT-DETAILS-IN 00852004
PERFORM 330-MOVE-WRITE-CURR-PARA THRU 330-EXIT 00860002
ELSE 00870002
CONTINUE 00880002
END-IF 00890002
END-IF. 00900002
00910002
PERFORM 200-GET-INPUT-PARA THRU 200-EXIT. 00920002
300-EXIT. EXIT. 00990000
01000000
320-MOVE-WRITE-SAVE-PARA. 01230002
MOVE ACCT-NUMBER OF ACCT-DETAILS-IN TO 01240000
ACCT-NUMBER OF SAVE-DETAILS-OT. 01250002
MOVE CUST-NAME OF ACCT-DETAILS-IN TO 01260000
CUST-NAME OF SAVE-DETAILS-OT. 01270002
MOVE ACCT-BAL OF ACCT-DETAILS-IN TO 01280000
ACCT-BAL OF SAVE-DETAILS-OT. 01290002
MOVE ACCT-TYPE OF ACCT-DETAILS-IN TO 01300000
ACCT-TYPE OF SAVE-DETAILS-OT. 01310002
WRITE SAVE-DETAILS-OT. 01320002
IF WS-SAF-STATUS = '00' 01330002
ADD +1 TO WS-OT-REC-CNT 01340000
ELSE 01350000
DISPLAY 'ERROR IN 320-PARA' 01360002
DISPLAY 'WRITE ERROR - STATUS IS ' WS-SAF-STATUS 01370002
DISPLAY 'RECORD IS ' ACCT-NUMBER OF ACCT-DETAILS-IN 01380000
CALL WS-ABENDPGM 01390000
END-IF. 01400000
320-EXIT. EXIT. 01410002
01411002
330-MOVE-WRITE-CURR-PARA. 01420002
MOVE ACCT-NUMBER OF ACCT-DETAILS-IN TO 01430002
ACCT-NUMBER OF CURR-DETAILS-OT. 01440002
MOVE CUST-NAME OF ACCT-DETAILS-IN TO 01450002
CUST-NAME OF CURR-DETAILS-OT. 01460002
MOVE ACCT-BAL OF ACCT-DETAILS-IN TO 01470002
ACCT-BAL OF CURR-DETAILS-OT. 01480002
MOVE ACCT-TYPE OF ACCT-DETAILS-IN TO 01490002
ACCT-TYPE OF CURR-DETAILS-OT. 01500002
WRITE CURR-DETAILS-OT. 01510002
IF WS-CUF-STATUS = '00' 01520002
ADD +1 TO WS-OT-REC-CNT 01530002
ELSE 01540002
DISPLAY 'ERROR IN 330-PARA' 01550002
DISPLAY 'WRITE ERROR - STATUS IS ' WS-CUF-STATUS 01560002
DISPLAY 'RECORD IS ' ACCT-NUMBER OF ACCT-DETAILS-IN 01570002
CALL WS-ABENDPGM 01580002
END-IF. 01590002
330-EXIT. EXIT. 01600002
//IBMUSERX JOB NOTIFY=&SYSUID
//STEP1 EXEC PGM=ADDPGM01
//STEPLIB DD DSN=IBMUSER.T5.LOAD,DISP=SHR
//SYSPRINT DD SYSOUT=*
//SYSOUT DD SYSOUT=*
//SYSIN DD *
20
30
/*
//

ID DIVISION.
PROGRAM-ID. ADDPGM01.
AUTHOR. NAME.
DATE-WRITTEN. TODAY.

ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.

DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 NUM1 PIC 9(02) VALUE ZERO.
01 NUM2 PIC 9(02) VALUE ZERO.
01 TOTAL PIC 9(02) VALUE ZERO.
01 WS-ABENDPGM PIC X(08) VALUE 'ABENDPGM'.
PROCEDURE DIVISION.
000-MAIN-PARA.
DISPLAY 'ADDPGM01 STARTED'.

ACCEPT NUM1
ACCEPT NUM2.

COMPUTE TOTAL = NUM1 + NUM2

ON SIZE ERROR
DISPLAY 'ERROR IN COMPUTE'
DISPLAY 'INPUT ARE ' NUM1 ' ' NUM2
CALL WS-ABENDPGM.

DISPLAY 'TOTAL IS ' TOTAL

STOP RUN. //IBMUSERX JOB
NOTIFY=&SYSUID 00010000
//STEP1 EXEC PGM=ADDPGM01 00020000
//STEPLIB DD DSN=IBMUSER.T5.LOAD,DISP=SHR 00030000
//SYSPRINT DD SYSOUT=* 00040000
//SYSOUT DD SYSOUT=* 00050000
//SYSIN DD * 00060001
20 00070002
30 00080002
/* 00090001
// 00100001
//IBMUSERX JOB NOTIFY=&SYSUID 00010000
//STEP1 EXEC PGM=CARDPGM1 00020000
//STEPLIB DD DSN=IBMUSER.T5.LOAD,DISP=SHR 00030000
//SYSPRINT DD SYSOUT=* 00040000
//SYSOUT DD SYSOUT=* 00050000
//SYSIN DD * 00060000
C1111 00070000
ANIL 00080000
10000 00090000
04000 00100000
Y 00110000
C1111 00120000
ARUN 00130000
10000 00140000
05000 00150000
Y 00160000
C3333 00170000
00180000
10000 00190000
02000 00200000
N 00210000
/* 00220000
// 00230000
ID DIVISION. 00010000
PROGRAM-ID. CARDPGM1. 00020000
AUTHOR. NAME. 00030000
DATE-WRITTEN. TODAY. 00040000
00050000
ENVIRONMENT DIVISION. 00060000
INPUT-OUTPUT SECTION. 00070000
FILE-CONTROL. 00080000
00090000
DATA DIVISION. 00100000
FILE SECTION. 00110000
WORKING-STORAGE SECTION. 00120000
01 CARD-DETAILS-IN. 00130000
03 CARD-NUMBER PIC X(05). 00140000
03 CUST-NAME PIC X(10). 00150000
03 CARD-LIMIT PIC S9(05). 00160000
03 CARD-DUE-AMT PIC S9(05). 00170000
00180000
01 CARD-DETAILS-OUT. 00190000
03 CARD-NUMBER PIC X(05) VALUE SPACE. 00200000
03 CUST-NAME PIC X(10) VALUE SPACE. 00210000
03 CARD-LIMIT PIC S9(05) VALUE ZERO. 00220000
03 CARD-DUE-AMT PIC S9(05) VALUE ZERO. 00230000
00240000
01 WS-ANY-MORE-INPUT PIC X(01) VALUE SPACE. 00250000
01 WS-VALID-INPUT PIC X(01) VALUE SPACE. 00260000
01 WS-IN-REC-CNT PIC 9(02) VALUE ZERO. 00270000
01 WS-OT-REC-CNT PIC 9(02) VALUE ZERO. 00280000
00290000
PROCEDURE DIVISION. 00300000
000-MAIN-PARA. 00310000
DISPLAY 'CARDPGM1 STARTED'. 00320000
00330000
PERFORM 100-INITIAL-PARA THRU 100-EXIT 00340000
PERFORM 200-GET-INPUT-PARA THRU 200-EXIT 00350000
PERFORM 300-PROCESS-PARA THRU 300-EXIT 00360000
UNTIL WS-ANY-MORE-INPUT = 'N'. 00370000
00380000
DISPLAY 'TOTAL INPUT REC COUNT ' WS-IN-REC-CNT. 00390000
DISPLAY 'TOTAL OUTPUT REC COUNT ' WS-OT-REC-CNT. 00400000
STOP RUN. 00410000
00420000
100-INITIAL-PARA. 00430000
MOVE ZERO TO WS-IN-REC-CNT 00440000
WS-OT-REC-CNT. 00450000
00460000
MOVE 'Y' TO WS-ANY-MORE-INPUT. 00470000
00480000
MOVE SPACE TO CARD-NUMBER OF CARD-DETAILS-IN 00490000
 CUST-NAME OF CARD-DETAILS-IN. 00500000
MOVE ZERO TO CARD-LIMIT OF CARD-DETAILS-IN 00510000
CARD-DUE-AMT OF CARD-DETAILS-IN. 00520000
00530000
100-EXIT. EXIT. 00540000
00550000
200-GET-INPUT-PARA. 00560000
ACCEPT CARD-NUMBER OF CARD-DETAILS-IN 00570000
ACCEPT CUST-NAME OF CARD-DETAILS-IN. 00580000
ACCEPT CARD-LIMIT OF CARD-DETAILS-IN 00590000
ACCEPT CARD-DUE-AMT OF CARD-DETAILS-IN. 00600000
ADD +1 TO WS-IN-REC-CNT. 00610000
200-EXIT. EXIT. 00620000
00630000
300-PROCESS-PARA. 00640000
MOVE 'Y' TO WS-VALID-INPUT. 00650000
PERFORM 310-AUDIT-INPUT-PARA THRU 310-EXIT. 00660000
00670000
IF WS-VALID-INPUT = 'Y' 00680000
PERFORM 340-MOVE-DISPLAY-PARA THRU 340-EXIT 00690000
END-IF. 00700000
00710000
ACCEPT WS-ANY-MORE-INPUT. 00720000
IF WS-ANY-MORE-INPUT = 'Y' 00730000
PERFORM 200-GET-INPUT-PARA THRU 200-EXIT 00740000
END-IF. 00750000
300-EXIT. EXIT. 00760000
00770000
310-AUDIT-INPUT-PARA. 00780000
IF CARD-NUMBER OF CARD-DETAILS-IN = SPACE 00790000
MOVE 'N' TO WS-VALID-INPUT 00800000
GO TO 310-EXIT 00810000
END-IF. 00820000
00830000
IF CUST-NAME OF CARD-DETAILS-IN = SPACE 00840000
MOVE 'N' TO WS-VALID-INPUT 00850000
GO TO 310-EXIT 00860000
END-IF. 00870000
00871000
IF CARD-LIMIT OF CARD-DETAILS-IN < 0 00872000
MOVE 'N' TO WS-VALID-INPUT 00873000
GO TO 310-EXIT 00874000
END-IF. 00875000
00876000
IF CARD-DUE-AMT OF CARD-DETAILS-IN < 0 00877000
MOVE 'N' TO WS-VALID-INPUT 00878000
END-IF. 00879000
00880000
310-EXIT. EXIT. 00890000
00900000
340-MOVE-DISPLAY-PARA. 00910000
MOVE CARD-NUMBER OF CARD-DETAILS-IN TO 00920000
CARD-NUMBER OF CARD-DETAILS-OUT. 00921000
MOVE CUST-NAME OF CARD-DETAILS-IN TO 00930000
CUST-NAME OF CARD-DETAILS-OUT. 00931000
MOVE CARD-LIMIT OF CARD-DETAILS-IN TO 00940000
CARD-LIMIT OF CARD-DETAILS-OUT. 00941000
MOVE CARD-DUE-AMT OF CARD-DETAILS-IN TO 00950000
CARD-DUE-AMT OF CARD-DETAILS-OUT. 00960000
 00970000
DISPLAY 'VALID CARD DETAILS ARE ' CARD-DETAILS-OUT. 00980000
ADD +1 TO WS-OT-REC-CNT. 00990000
01000000
340-EXIT. EXIT. 01010000
//IBMUSERX JOB NOTIFY=&SYSUID 00010000
//STEP1 EXEC PGM=CBLPGM33 00020000
//STEPLIB DD DSN=IBMUSER.E5.LOAD,DISP=SHR 00030000
//SYSOUT DD SYSOUT=* 00040000
//SYSPRINT DD SYSOUT=* 00050000
//LBDDIN01 DD DSN=IBMUSER.E5.LAB.FILE,DISP=SHR 00060000
//LBDDIN02 DD DSN=IBMUSER.E5.WAG.FILE,DISP=SHR 00070000
//LBDDOT01 DD DSN=IBMUSER.E5.PAY.FIL2,DISP=(NEW,CATLG,DELETE), 00080002
// UNIT=3390,VOL=SER=S7SYS1, 00090000
// SPACE=(TRK,(1,1),RLSE), 00100000
// DCB=(DSORG=PS,LRECL=24,RECFM=FB,BLKSIZE=0) 00110000
// 00120000
ID DIVISION. 00010000
PROGRAM-ID. CBLGPM01. 00020000
AUTHOR. NAME. 00030000
DATE-WRITTEN. TODAY. 00040000
00050000
ENVIRONMENT DIVISION. 00060000
INPUT-OUTPUT SECTION. 00070000
FILE-CONTROL. 00080000
00090000
DATA DIVISION. 00100000
FILE SECTION. 00110000
WORKING-STORAGE SECTION. 00120000
LINKAGE SECTION. 00130000
00140000
PROCEDURE DIVISION. 00150000
000-MAIN-PARA. 00160000
DISPLAY ' HELLO ALL'. 00170000
DISPLAY ' WELCOME ALL '. 00180000
STOP RUN. 00190000
ID DIVISION. 00010000
PROGRAM-ID. CBLPGM02. 00020000
AUTHOR. NAME. 00030000
DATE-WRITTEN. TODAY. 00040000
00050000
PROCEDURE DIVISION. 00060000
000-MAIN-PARA. 00070000
DISPLAY 'SEE U TOMORROW'. 00080000
STOP RUN. 00090000
000100 IDENTIFICATION DIVISION. 00010000
000200 PROGRAM-ID. CBLPGM33. 00020000
000300 AUTHOR. UR NAME. 00030000
000400 DATE-WRITTEN. TODAY. 00040000
000500 00050000
000600 ENVIRONMENT DIVISION. 00060000
000700 INPUT-OUTPUT SECTION. 00070000
000800 FILE-CONTROL. 00080000
000900 SELECT LBDETAIL ASSIGN TO LBDDIN01 00090000
001000 ORGANIZATION IS SEQUENTIAL 00100000
001100 ACCESS MODE IS SEQUENTIAL 00110000
001200 FILE STATUS IS WS-LBIN-STATUS. 00120000
001300 00130000
001400 SELECT WGDETAIL ASSIGN TO LBDDIN02 00140000
001500 ORGANIZATION IS SEQUENTIAL 00150000
001600 ACCESS MODE IS SEQUENTIAL 00160000
001700 FILE STATUS IS WS-WGIN-STATUS. 00170000
001800 00180000
001900 SELECT PYCHKRPT ASSIGN TO LBDDOT01 00190000
002000 ORGANIZATION IS SEQUENTIAL 00200000
002100 ACCESS MODE IS SEQUENTIAL 00210000
002200 FILE STATUS IS WS-LBOUT-STATUS. 00220000
002300 00230000
002400 DATA DIVISION. 00240000
002500 FILE SECTION. 00250000
002600 FD LBDETAIL 00260000
002700 LABEL RECORDS ARE STANDARD 00270000
002800 RECORDING MODE IS F 00280000
002900 RECORD CONTAINS 21 CHARACTERS 00290000
003000 BLOCK CONTAINS 0 RECORDS. 00300000
003100 01 LABOUR-DETAILS. 00310000
003200 03 LABOUR-ID PIC X(05). 00320000
003300 03 LABOUR-NAME PIC X(10). 00330000
003400 03 LABOUR-RG-WORK-HRS PIC 9(02). 00340000
003500 03 LABOUR-OT-WORK-HRS PIC 9(02). 00350000
003600 03 LABOUR-WORK-TYPE PIC X(02). 00360000
003700 00370000
003800 FD WGDETAIL 00380000
003900 LABEL RECORDS ARE STANDARD 00390000
004000 RECORDING MODE IS F 00400000
004100 RECORD CONTAINS 06 CHARACTERS 00410002
004200 BLOCK CONTAINS 0 RECORDS. 00420000
004300 01 WG-DETAILS-IN. 00430000
004400 03 LABOUR-WORK-TYPEG PIC X(02). 00440000
004500 03 RG-HR-PAY-AMTG PIC 9(02). 00450000
004600 03 OT-HR-PAY-AMTG PIC 9(02). 00460000
004700 00470000
004800 FD PYCHKRPT 00480000
004900 LABEL RECORDS ARE STANDARD 00490000
005000 RECORDING MODE IS F 00500000
005100 RECORD CONTAINS 24 CHARACTERS 00510002
005200 BLOCK CONTAINS 0 RECORDS. 00520000
005300 01 LABOUR-DETAILS-OT. 00530000
005400 03 LABOUR-ID PIC X(05). 00540000
005500 03 LABOUR-NAME PIC X(10). 00550000
005600 03 LABOUR-TOTAL-WORK-HRS PIC 9(02). 00560000
005700 03 LABOUR-WORK-TYPE PIC X(02). 00570000
005800 03 LABOUR-TOTAL-SALARY PIC 9(05). 00580000
005900 00590000
006000 WORKING-STORAGE SECTION. 00600000
006100 00610000
006200 01 WS-LBIN-STATUS PIC X(02) VALUE SPACE. 00620000
006300 01 WS-WGIN-STATUS PIC X(02) VALUE SPACE. 00630000
006400 01 WS-LBOUT-STATUS PIC X(02) VALUE SPACE. 00640000
006500 01 WS-END-OF-FILE PIC X(01) VALUE SPACE. 00650000
006600 01 WS-END-WG-FILE PIC X(01) VALUE SPACE. 00660000
006700 01 WS-WORK-TYPE-FOUND PIC X(01) VALUE SPACE. 00670001
006800 00680000
007100 01 WS-RG-WORK-AMT PIC 9(02) VALUE ZERO. 00690000
007200 01 WS-OT-WORK-AMT PIC 9(02) VALUE ZERO. 00700000
007300 01 WS-TOTAL-RG-AMT PIC 9(04) VALUE ZERO. 00710000
007400 01 WS-TOTAL-OT-AMT PIC 9(04) VALUE ZERO. 00720000
01 WS-LABOUR-TOTAL-SALARY PIC 9(05) VALUE ZERO. 00730000
007500 00740000
008100 01 SUB PIC 9(01) VALUE ZERO. 00750000
008200 01 WS-ABENDPGM PIC X(08) VALUE 'ABENDPGM'. 00760000
007600 01 WS-WAGE-DETAILS. 00770000
007700 03 WG-DETAILS OCCURS 2 TIMES INDEXED BY IDX. 00780000
007800 05 WS-LABOUR-WORK-TYPE PIC X(02). 00790000
007900 05 WS-RG-HR-PAY-AMT PIC 9(02). 00800000
008000 05 WS-OT-HR-PAY-AMT PIC 9(02). 00810000
008300 PROCEDURE DIVISION. 00820000
008400 0000-MAIN-PARA. 00830000
008500 PERFORM 1000-INITIAL-PARA THRU 1000-EXIT. 00840000
PERFORM 1700-GET-LB-PARA THRU 1700-EXIT. 00850000
008600 PERFORM 2000-PROCESS-PARA THRU 2000-EXIT 00860000
008700 UNTIL WS-END-OF-FILE = 'Y'. 00870000
008800 CLOSE LBDETAIL WGDETAIL PYCHKRPT. 00880000
008900 STOP RUN. 00890000
009000 00900000
009100 1000-INITIAL-PARA. 00910000
009200 MOVE 'N' TO WS-END-OF-FILE. 00920000
009300 MOVE 'N' TO WS-END-WG-FILE. 00930000
009400 MOVE 'Y' TO WS-WORK-TYPE-FOUND. 00940000
009500 00950000
009600 OPEN INPUT LBDETAIL, WGDETAIL. 00960000
009700 OPEN OUTPUT PYCHKRPT. 00970000
009800 IF WS-LBIN-STATUS NOT = '00' OR 00980000
009900 WS-WGIN-STATUS NOT = '00' OR 00990000
010000 WS-LBOUT-STATUS NOT = '00' 01000000
010100 DISPLAY 'ERROR IN 1000-PARA TO OPEN FILE ' 01010000
010200 DISPLAY 'STATUS CODES ARE ' WS-LBIN-STATUS ' ' 01020000
010300 WS-WGIN-STATUS ' ' WS-LBOUT-STATUS 01030000
CALL WS-ABENDPGM 01040000
010500 END-IF. 01050000
010600 PERFORM 1500-BLD-WAGE-TABLE-PARA THRU 1500-EXIT 01060001
010700 UNTIL WS-END-WG-FILE = 'Y'. 01070000
010800 01080000
010900 1000-EXIT. EXIT. 01090000
011000 01100000
011100 1500-BLD-WAGE-TABLE-PARA. 01110001
011200 READ WGDETAIL 01120000
011300 AT END MOVE 'Y' TO WS-END-WG-FILE 01130000
011400 GO TO 1500-EXIT. 01140000
011500 ADD +1 TO SUB. 01150000
011600 01160000
011700 MOVE LABOUR-WORK-TYPEG TO WS-LABOUR-WORK-TYPE (SUB) 01170000
011800 MOVE RG-HR-PAY-AMTG TO WS-RG-HR-PAY-AMT (SUB) 01180000
011900 MOVE OT-HR-PAY-AMTG TO WS-OT-HR-PAY-AMT (SUB). 01190000
012000 01200000
012100 1500-EXIT. EXIT. 01210000
01220000
012200 1700-GET-LB-PARA. 01230000
012500 READ LBDETAIL 01240000
012600 AT END 01250000
012700 MOVE 'Y' TO WS-END-OF-FILE 01260000
012800 GO TO 2000-EXIT. 01270000
009800 IF WS-LBIN-STATUS NOT = '00' 01280000
010100 DISPLAY 'ERROR IN 2000-PARA TO READ LABOUR FILE ' 01290000
010200 DISPLAY 'STATUS CODE IS ' WS-LBIN-STATUS 01300000
010400 CALL WS-ABENDPGM 01310000
010500 END-IF. 01320000
 1700-EXIT. EXIT. 01330000
01340000
012300 2000-PROCESS-PARA. 01350000
012900 MOVE 'Y' TO WS-WORK-TYPE-FOUND. 01360003
013000 PERFORM 2600-GET-WAGE-DETAILS-PARA THRU 2600-EXIT. 01370000
013100 IF WS-WORK-TYPE-FOUND = 'Y' 01380000
013200 01390000
013300 COMPUTE LABOUR-TOTAL-WORK-HRS = 01400000
013300 LABOUR-RG-WORK-HRS + LABOUR-OT-WORK-HRS 01410000
013400 COMPUTE WS-TOTAL-RG-AMT = 01420000
013400 LABOUR-RG-WORK-HRS * WS-RG-WORK-AMT 01430000
013500 COMPUTE WS-TOTAL-OT-AMT = 01440000
013500 LABOUR-OT-WORK-HRS * WS-OT-WORK-AMT 01450000
013600 COMPUTE WS-LABOUR-TOTAL-SALARY = 01460000
013600 WS-TOTAL-RG-AMT + WS-TOTAL-OT-AMT 01470000
013700 PERFORM 2700-WRITE-OUTPUT-PARA THRU 2700-EXIT 01480000
013800 ELSE 01490000
013900 DISPLAY 'ERROR WITH INPUT LABOUR DATA ' 01500000
014000 DISPLAY 'INVALID WORK-TYPE INPUT ' LABOUR-DETAILS 01510000
014100 END-IF. 01520000
014200 PERFORM 1700-GET-LB-PARA THRU 1700-EXIT. 01530000
014300 2000-EXIT. EXIT. 01540000
014310 01550000
014400 2600-GET-WAGE-DETAILS-PARA. 01560000
014500 SET IDX TO 1. 01570000
014600 01580000
014700 SEARCH WG-DETAILS 01590000
014800 AT END 01600000
014900 MOVE 'N' TO WS-WORK-TYPE-FOUND 01610000
015100 WHEN LABOUR-WORK-TYPE OF LABOUR-DETAILS 01620000
015100 = WS-LABOUR-WORK-TYPE (IDX) 01630000
015200 MOVE WS-RG-HR-PAY-AMT (IDX) TO WS-RG-WORK-AMT 01640000
015300 MOVE WS-OT-HR-PAY-AMT (IDX) TO WS-OT-WORK-AMT 01650000
015500 END-SEARCH. 01660000
015600 01670000
015700 2600-EXIT. EXIT. 01680000
015800 01690000
015900 2700-WRITE-OUTPUT-PARA. 01700000
016000 MOVE LABOUR-ID OF LABOUR-DETAILS 01710000
016000 TO LABOUR-ID OF LABOUR-DETAILS-OT. 01720000
016300 MOVE LABOUR-NAME OF LABOUR-DETAILS 01730000
016300 TO LABOUR-NAME OF LABOUR-DETAILS-OT. 01740000
016300 MOVE LABOUR-WORK-TYPE OF LABOUR-DETAILS 01750000
016400 TO LABOUR-WORK-TYPE OF LABOUR-DETAILS-OT. 01760000
016500 MOVE WS-LABOUR-TOTAL-SALARY 01770000
016500 TO LABOUR-TOTAL-SALARY OF LABOUR-DETAILS-OT. 01780000
016600 WRITE LABOUR-DETAILS-OT. 01790000
009800 IF WS-LBOUT-STATUS NOT = '00' 01800000
010100 DISPLAY 'ERROR IN 2700-PARA TO WRITE LB-OUTFILE ' 01810000
010200 DISPLAY 'STATUS CODE IS ' WS-LBOUT-STATUS 01820000
010400 CALL WS-ABENDPGM 01830000
010500 END-IF. 01840000
016700 01850000
016800 2700-EXIT. EXIT. 01860000
//IBMUSERX JOB NOTIFY=&SYSUID 00010000
//STEP1 EXEC PGM=CBLPGM01 00020000
//STEPLIB DD DSN=IBMUSER.T5.LOAD,DISP=SHR 00030000
//SYSPRINT DD SYSOUT=* 00040000
//SYSOUT DD SYSOUT=* 00050000
// 00060000
//IBMUSERX JOB NOTIFY=&SYSUID 00010000
//STEP1 EXEC PGM=CBLPGM02 00020000
//STEPLIB DD DSN=IBMUSER.T5.LOAD,DISP=SHR 00030000
//SYSPRINT DD SYSOUT=* 00040000
//SYSOUT DD SYSOUT=* 00050000
// 00060000

ID DIVISION.
PROGRAM-ID. CUSTPGM1.
AUTHOR. NAME.
DATE-WRITTEN. TODAY.

ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.

DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 CUST-DETAILS-IN.
03 CUST-ID PIC X(05).
03 CUST-NAME PIC X(10).
03 CUST-GENDER PIC X(10).

01 CUST-DETAILS-OUT.
03 CUST-ID PIC X(05) VALUE SPACE.
03 CUST-TITLE PIC X(03) VALUE SPACE.
03 CUST-NAME PIC X(10) VALUE SPACE.
03 CUST-GENDER PIC X(10) VALUE SPACE.

PROCEDURE DIVISION.
000-MAIN-PARA.
PROCEDURE DIVISION.
000-MAIN-PARA.
DISPLAY 'CUSTPGM1 STARTED'.

MOVE SPACE TO CUST-ID OF CUST-DETAILS-IN

CUST-NAME OF CUST-DETAILS-IN
CUST-GENDER OF CUST-DETAILS-IN.

ACCEPT CUST-ID OF CUST-DETAILS-IN

ACCEPT CUST-NAME OF CUST-DETAILS-IN
ACCEPT CUST-GENDER OF CUST-DETAILS-IN.

IF CUST-GENDER OF CUST-DETAILS-IN = 'MALE'

MOVE 'MR' TO CUST-TITLE OF CUST-DETAILS-OUT
ELSE
IF CUST-GENDER OF CUST-DETAILS-IN = 'FEMALE'
MOVE 'MRs' TO CUST-TITLE OF CUST-DETAILS-OUT
ELSE
DISPLAY 'INVALID GENDER INPUT ' CUST-DETAILS-IN
CALL WS-ABENDPGM
END-IF
END-IF.

MOVE CUST-ID OF CUST-DETAILS-IN TO

CUST-ID OF CUST-DETAILS-OUT
MOVE CUST-NAME OF CUST-DETAILS-IN TO
 CUST-NAME OF CUST-DETAILS-OUT
MOVE CUST-GENDER OF CUST-DETAILS-IN TO
CUST-GENDER OF CUST-DETAILS-OUT.

DISPLAY 'CUSTOMER DETAILS WITH TITLE ' CUST-DETAILS-OUT.

STOP RUN.

//IBMUSERX JOB NOTIFY=&SYSUID

//STEP1 EXEC PGM=CUSTPGM1
//STEPLIB DD DSN=IBMUSER.T5.LOAD,DISP=SHR
//SYSPRINT DD SYSOUT=*
//SYSOUT DD SYSOUT=*
//SYSIN DD *
C1234
ANIL
MALE
/*
//
//IBMUSERX JOB NOTIFY=&SYSUID 00010000
//STEP1 EXEC PGM=MAINPGM1 00020000
//STEPLIB DD DSN=IBMUSER.T5.LOAD,DISP=SHR 00030000
//SYSPRINT DD SYSOUT=* 00040000
//SYSOUT DD SYSOUT=* 00050000
//SYSIN DD * 00060000
BINDU 00070005
/* 00080000
// 00090000
ID DIVISION. 00010000
PROGRAM-ID. MAINPGM1. 00020000
AUTHOR. NAME. 00030000
DATE-WRITTEN. TODAY. 00040000
00050000
ENVIRONMENT DIVISION. 00060000
INPUT-OUTPUT SECTION. 00070000
FILE-CONTROL. 00080000
00090000
DATA DIVISION. 00100000
FILE SECTION. 00110000
WORKING-STORAGE SECTION. 00120000
01 CUST-NAME PIC X(20) VALUE SPACE. 00130000
01 STR-LEN PIC 9(02) VALUE ZERO. 00140000
01 LETTER-FOUND PIC X(01) VALUE SPACE. 00150004
PROCEDURE DIVISION. 00160000
000-MAIN-PARA. 00170000
DISPLAY 'AM IN MAINPGM'. 00180000
00190000
ACCEPT CUST-NAME. 00200000
DISPLAY 'CUSTOMER NAME IS 1 ' CUST-NAME. 00201003
DISPLAY 'TOTAL VARIABLE LEN IS ' LENGTH OF CUST-NAME. 00202000
00203004
MOVE ZERO TO STR-LEN. 00210000
MOVE 'N' TO LETTER-FOUND. 00211004
CALL 'SUBPGM01' USING CUST-NAME STR-LEN LETTER-FOUND. 00220004
00221004
DISPLAY 'TOTAL STRING LEN IS ' STR-LEN. 00230000
IF LETTER-FOUND = 'Y' 00240004
DISPLAY 'CUSTOMER NAME ' CUST-NAME ' CONTAINS LETTER A' 00247004
ELSE 00248004
 DISPLAY 'CUSTOMER NAME ' CUST-NAME ' DO NOT HAVE LET A' 00249004
END-IF. 00249104
STOP RUN. 00250000
ID DIVISION. 00010000
PROGRAM-ID. MATCHLP1. 00020003
AUTHOR. ANIL POLSANI. 00030000
DATE-WRITTEN. TODAY. 00040000
00050000
ENVIRONMENT DIVISION. 00060000
INPUT-OUTPUT SECTION. 00070000
FILE-CONTROL. 00080000
SELECT TRAN-INFILE ASSIGN TO TRANSDD1 00090000
ORGANIZATION IS SEQUENTIAL 00100000
ACCESS MODE IS SEQUENTIAL 00110000
FILE STATUS IS WS-TF-STATUS. 00120000
00130000
SELECT MAST-INFILE ASSIGN TO MASTDD01 00140000
ORGANIZATION IS SEQUENTIAL 00150000
ACCESS MODE IS SEQUENTIAL 00160000
FILE STATUS IS WS-MF-STATUS. 00170000
00180000
SELECT BILL-OTFILE ASSIGN TO BILLDD01 00190000
ORGANIZATION IS SEQUENTIAL 00200000
ACCESS MODE IS SEQUENTIAL 00210000
FILE STATUS IS WS-BF-STATUS. 00220000
00230000
DATA DIVISION. 00240000
FILE SECTION. 00250000
FD TRAN-INFILE 00260000
LABEL RECORD ARE STANDARD. 00270000
COPY TRANCPY2. 00280000
00290000
FD MAST-INFILE 00300000
LABEL RECORD ARE STANDARD. 00310000
COPY MASTCPY1. 00320000
00330000
FD BILL-OTFILE 00340000
LABEL RECORD ARE STANDARD. 00350000
COPY BILLCPY1. 00360000
00370000
WORKING-STORAGE SECTION. 00380000
01 WS-TF-STATUS PIC X(02) VALUE SPACE. 00390000
01 WS-MF-STATUS PIC X(02) VALUE SPACE. 00400000
01 WS-BF-STATUS PIC X(02) VALUE SPACE. 00410000
00420000
01 WS-END-OF-TFILE PIC X(01) VALUE SPACE. 00430000
01 WS-END-OF-MFILE PIC X(01) VALUE SPACE. 00440000
00450000
01 WS-IN-REC-CNT PIC 9(02) VALUE ZERO. 00460000
01 WS-OT-REC-CNT PIC 9(02) VALUE ZERO. 00470000
01 WS-ABENDPGM PIC X(08) VALUE 'ABENDPGM'. 00480000
00480101
01 WS-TOTL-DUE-2-PAY PIC S9(05)V9(02) VALUE ZERO. 00481001
01 WS-PREV-DUE-AMT PIC S9(05)V9(02) VALUE ZERO. 00481101
01 WS-DUE-INST PIC S9(05)V9(02) VALUE ZERO. 00481201
01 WS-MIN-DUE-AMT PIC S9(05)V9(02) VALUE ZERO. 00482001
01 WS-CURR-DATE-ALPNUM PIC X(08) VALUE SPACE. 00483001
01 WS-CURR-DATE-NUM PIC 9(08) VALUE ZERO. 00483101
01 WS-DUE-DATE PIC 9(08) VALUE ZERO. 00484001
01 WS-DUE-DATE-ALPNUM PIC X(08) VALUE SPACE. 00484101
01 WS-NUM-OF-DAYS PIC 9(08) VALUE ZERO. 00485001
00490000
PROCEDURE DIVISION. 00500000
000-MAIN-PARA. 00510000
DISPLAY 'MATCHLP1 STARTED'. 00520003
00530000
PERFORM 100-INITIAL-PARA THRU 100-EXIT 00540000
PERFORM 200-GET-INPUT-PARA THRU 200-EXIT 00550000
PERFORM 300-PROCESS-PARA THRU 300-EXIT 00560000
UNTIL WS-END-OF-TFILE = 'Y'. 00570000
00580000
CLOSE TRAN-INFILE MAST-INFILE BILL-OTFILE. 00590000
DISPLAY 'TOTAL INPUT RECORD COUNT ' WS-IN-REC-CNT. 00600000
DISPLAY 'TOTAL OTPUT RECORD COUNT ' WS-OT-REC-CNT. 00610000
STOP RUN. 00620000
00630000
100-INITIAL-PARA. 00640000
MOVE 'N' TO WS-END-OF-TFILE. 00650000
MOVE 'N' TO WS-END-OF-MFILE. 00660000
00670000
MOVE ZERO TO WS-IN-REC-CNT WS-OT-REC-CNT. 00680000
00690000
OPEN INPUT TRAN-INFILE MAST-INFILE. 00700000
OPEN OUTPUT BILL-OTFILE. 00710000
IF WS-MF-STATUS NOT = '00' OR 00720000
WS-TF-STATUS NOT = '00' OR 00730000
WS-BF-STATUS NOT = '00' 00740000
DISPLAY 'ERROR IN 100-PARA' 00750000
DISPLAY 'STATUS CODE TRAN FILE IS ' WS-TF-STATUS 00760000
DISPLAY 'STATUS CODE MAST FILE IS ' WS-MF-STATUS 00761000
DISPLAY 'STATUS CODE BILL FILE IS ' WS-BF-STATUS 00762000
CALL WS-ABENDPGM 00770000
END-IF. 00780000
INITIALIZE TRANS-LAYOUT MASTER-LAYOUT BILL-LAYOUT. 00790002
100-EXIT. EXIT. 00800000
00810000
200-GET-INPUT-PARA. 00820000
PERFORM 210-GET-TRAN-FILE-PARA THRU 210-EXIT. 00830000
PERFORM 220-GET-MAST-FILE-PARA THRU 220-EXIT. 00840000
200-EXIT. EXIT. 00850000
00860000
210-GET-TRAN-FILE-PARA. 00870000
READ TRAN-INFILE 00880000
AT END 00890000
MOVE 'Y' TO WS-END-OF-TFILE 00900000
GO TO 210-EXIT. 00910000
ADD +1 TO WS-IN-REC-CNT. 00920000
210-EXIT. EXIT. 00930000
00940000
220-GET-MAST-FILE-PARA. 00950000
READ MAST-INFILE 00960000
AT END 00970000
MOVE 'Y' TO WS-END-OF-MFILE 00980000
GO TO 220-EXIT. 00990000
220-EXIT. EXIT. 01010000
01020000
300-PROCESS-PARA. 01030000
IF CARD-NUMBER OF TRANS-LAYOUT = CARD-NUMBER OF 01040002
 MASTER-LAYOUT 01050000
PERFORM 310-CAL-TOT-DUE-PARA THRU 310-EXIT 01060000
PERFORM 320-CAL-MIN-DUE-PARA THRU 320-EXIT 01070000
PERFORM 330-GET-DUE-DATE-PARA THRU 330-EXIT 01080000
PERFORM 340-MOVE-WRITE-PARA THRU 340-EXIT 01090000
PERFORM 200-GET-INPUT-PARA THRU 200-EXIT 01091000
ELSE 01100000
IF CARD-NUMBER OF TRANS-LAYOUT > CARD-NUMBER OF 01110002
MASTER-LAYOUT 01120000
PERFORM 220-GET-MAST-FILE-PARA THRU 220-EXIT 01130000
ELSE 01140000
DISPLAY 'INVALID CARD-NUMBER IN TRANS-FILE' 01150000
DISPLAY 'NO RECORD IN MASTER FILE ' 01160000
DISPLAY 'CARD NUMBER IS ' CARD-NUMBER OF TRANS-LAYOUT 01170000
CALL WS-ABENDPGM 01180000
END-IF 01190000
END-IF. 01200000
300-EXIT. EXIT. 01210000
01220001
310-CAL-TOT-DUE-PARA. 01230001
MOVE ZERO TO WS-PREV-DUE-AMT 01231001
WS-DUE-INST 01232001
WS-TOTL-DUE-2-PAY. 01233001
01234001
COMPUTE WS-PREV-DUE-AMT = PREVIOUS-DUE - PREVIOUS-DUE-PAID 01240001
IF WS-PREV-DUE-AMT > 0 01250001
COMPUTE WS-DUE-INST = WS-PREV-DUE-AMT * .15 01260001
END-IF. 01270001
COMPUTE WS-TOTL-DUE-2-PAY = WS-PREV-DUE-AMT + 01280001
WS-DUE-INST + 01290001
DUE-AMT-TO-PAY. 01300001
310-EXIT. EXIT. 01310001
01320001
320-CAL-MIN-DUE-PARA. 01330001
MOVE ZERO TO WS-MIN-DUE-AMT. 01331001
COMPUTE WS-MIN-DUE-AMT = WS-TOTL-DUE-2-PAY * .15. 01340001
320-EXIT. EXIT. 01350001
01360001
330-GET-DUE-DATE-PARA. 01370001
MOVE FUNCTION CURRENT-DATE TO WS-CURR-DATE-ALPNUM. 01380001
MOVE WS-CURR-DATE-ALPNUM TO WS-CURR-DATE-NUM. 01390001
01400001
COMPUTE WS-NUM-OF-DAYS = FUNCTION 01410001
INTEGER-OF-DATE(WS-CURR-DATE-NUM) 01420001
COMPUTE WS-NUM-OF-DAYS = WS-NUM-OF-DAYS + 20. 01430001
COMPUTE WS-DUE-DATE = FUNCTION 01440001
DATE-OF-INTEGER(WS-NUM-OF-DAYS). 01450001
01460001
MOVE WS-DUE-DATE TO WS-DUE-DATE-ALPNUM. 01470001
330-EXIT. EXIT. 01480001
01490001
340-MOVE-WRITE-PARA. 01500001
MOVE CARD-NUMBER OF MASTER-LAYOUT TO 01510001
CARD-NUMBER OF BILL-LAYOUT 01520001
MOVE CUST-NAME OF MASTER-LAYOUT TO 01530001
CUST-NAME OF BILL-LAYOUT. 01540001
MOVE WS-TOTL-DUE-2-PAY TO TOT-DUE-2-PAY 01550001
MOVE WS-MIN-DUE-AMT TO MIN-DUE-2-PAY 01560001
MOVE WS-CURR-DATE-ALPNUM TO BILLING-DATE 01570001
 MOVE WS-DUE-DATE-ALPNUM TO DUE-DATE. 01580001
WRITE BILL-LAYOUT. 01590001
IF WS-BF-STATUS NOT = '00' 01600001
DISPLAY 'ERROR IN 340-PARA' 01610001
DISPLAY 'WRITE ERROR STATUS CODE IS ' WS-BF-STATUS 01620001
DISPLAY 'RECORD IS ' CARD-NUMBER OF MASTER-LAYOUT 01630001
CALL WS-ABENDPGM 01640001
END-IF. 01650001
ADD +1 TO WS-OT-REC-CNT. 01660001
340-EXIT. EXIT. 01670001
//IBMUSERX JOB NOTIFY=&SYSUID 00010000
//STEP1 EXEC PGM=MATCHLP1 00020001
//STEPLIB DD DSN=IBMUSER.T5.LOAD,DISP=SHR 00030001
//SYSPRINT DD SYSOUT=* 00040000
//SYSOUT DD SYSOUT=* 00050000
//TRANSDD1 DD DSN=IBMUSER.T5.CC.TRANS,DISP=SHR 00060001
//MASTDD01 DD DSN=IBMUSER.T5.CC.MAST,DISP=SHR 00070001
//BILLDD01 DD DSN=IBMUSER.T5.CC.BILLRPT,DISP=(NEW,CATLG,DELETE), 00080001
// UNIT=3390,VOL=SER=JASYS1, 00090000
// SPACE=(TRK,(1,1),RLSE), 00100000
// DCB=(DSORG=PS,LRECL=45,RECFM=FB,BLKSIZE=0) 00110000
// 00120000
ID DIVISION. 00010000
PROGRAM-ID. SUBPGM01. 00020000
AUTHOR. NAME. 00030000
DATE-WRITTEN. TODAY. 00040000
00050000
ENVIRONMENT DIVISION. 00060000
INPUT-OUTPUT SECTION. 00070000
FILE-CONTROL. 00080000
00090000
DATA DIVISION. 00100000
FILE SECTION. 00110000
WORKING-STORAGE SECTION. 00120000
01 WS-SPACE-LEN PIC 9(02) VALUE ZERO. 00130000
01 WS-I PIC 9(02) VALUE ZERO. 00131003
LINKAGE SECTION. 00140000
01 CUST-NAME PIC X(20). 00150000
01 STR-LEN PIC 9(02). 00160000
01 LETTER-FOUND PIC X(01). 00170002
PROCEDURE DIVISION USING CUST-NAME STR-LEN LETTER-FOUND. 00180002
000-MAIN-PARA. 00190000
DISPLAY 'AM IN SUBPGM01'. 00200000
PERFORM 100-FIND-STR-LEN-PARA THRU 100-EXIT. 00201002
PERFORM 200-FIND-LETTER-PARA THRU 200-EXIT. 00201102
GOBACK. 00201202
00201302
100-FIND-STR-LEN-PARA. 00202002
MOVE ZERO TO WS-SPACE-LEN. 00210001
INSPECT FUNCTION REVERSE(CUST-NAME) TALLYING WS-SPACE-LEN 00220000
FOR LEADING SPACE. 00230000
DISPLAY 'EXTRA SPACE COUNT ' WS-SPACE-LEN. 00240000
COMPUTE STR-LEN = LENGTH OF CUST-NAME - WS-SPACE-LEN. 00250000
00260000
100-EXIT. EXIT. 00270002
00280002
200-FIND-LETTER-PARA. 00290002
MOVE +1 TO WS-I. 00300002
PERFORM UNTIL WS-I > 20 OR WS-I > STR-LEN 00310004
 OR LETTER-FOUND = 'Y' 00311005
IF CUST-NAME(WS-I:1) = 'A' 00320002
MOVE 'Y' TO LETTER-FOUND 00330002
END-IF 00340002
DISPLAY 'WS-I IS ' WS-I 00341002
ADD +1 TO WS-I 00350002
END-PERFORM. 00360002
200-EXIT. EXIT. 00370002
000100 IDENTIFICATION DIVISION. 00010000
000200* 00020000
000300 PROGRAM-ID. SUBPGM02. 00030000
000400* 00040000
000500 ENVIRONMENT DIVISION. 00050000
000600* 00060000
000700 DATA DIVISION. 00070000
000800* 00080000
000900 WORKING-STORAGE SECTION. 00090000
001000* 00100000
001100 01 SWITCH. 00110000
001200* 00120000
001300 05 LENGTH-DETERMINED-SW PIC X VALUE 'N'. 00130000
001400 88 LENGTH-DETERMINED VALUE 'Y'. 00140000
001500* 00150000
001600 LINKAGE SECTION. 00160000
001700* 00170000
001800 01 TEXT-LENGTH PIC S9(4) COMP. 00180000
001900* 00190000
002000 01 WORK-TABLE. 00200000
002100* 00210000
002200 05 WT-CHARACTER OCCURS 1 TO 254 TIMES 00220000
002300 DEPENDING ON TEXT-LENGTH 00230000
002400 PIC X. 00240000
002500* 00250000
002600 PROCEDURE DIVISION USING TEXT-LENGTH 00260000
002700 WORK-TABLE. 00270000
002800* 00280000
002900 000-DETERMINE-STRING-LENGTH. 00290000
003000* 00300000
003100 MOVE 'N' TO LENGTH-DETERMINED-SW. 00310000
003200 PERFORM 100-EXAMINE-LAST-CHARACTER 00320000
003300 UNTIL LENGTH-DETERMINED. 00330000
003400* 00340000
003500 000-EXIT. 00350000
003600* 00360000
003700 EXIT PROGRAM. 00370000
003800* 00380000
003900 100-EXAMINE-LAST-CHARACTER. 00390000
004000* 00400000
004100 IF WT-CHARACTER(TEXT-LENGTH) = SPACE 00410000
004200 SUBTRACT 1 FROM TEXT-LENGTH 00420000
004300 ELSE 00430000
004400 MOVE 'Y' TO LENGTH-DETERMINED-SW. 00440000
004500 IF TEXT-LENGTH = 0 00450000
004600 MOVE 'Y' TO LENGTH-DETERMINED-SW. 00460000
004700* 00470000