用COBOL做的Casestudy

这是公司培训Mainframe技术时，为一个Casestudy写的COBOL程序。这个是最开始的一周COBOL培训结束时做的，还没牵涉到DB2、CICS等技术。先把程序贴上来，需要找COBOL例程的同志们可以参考下。

文件数据集名称(PDS)：TRGO20.CASESTDY.SOURCE Member: CASEMAIN

程序的正确性是没问题的，已经在印度的Mainframe上面compile&linking通过了。运行调试也做了，能够生成正常的报告。 Full test没有做，也没精力做了，生成完整的Test Use Case，对这个Training，好像没什么必要。这个程序主要是从两个Transaction File中读取记录，与Data File做Validation之后，以一定的格式生成Error Report，或者是Normal Report，要求每30行打出一个分页符，但是ADVANCING PAGE命令似乎不能正常工作，会产生记录长度溢出1位的错误，增加每条记录的长度也未能解决，只好先放一放了。有哪位朋友知道是怎么回事，还请多多指教。

000101 IDENTIFICATION DIVISION.
000102 PROGRAM-ID. CASEMAIN.
000103
000104 ENVIRONMENT DIVISION.
000105 CONFIGURATION SECTION.
000106 INPUT-OUTPUT SECTION.
000107 FILE-CONTROL.
000108     SELECT TRNSF ASSIGN TO TRNSFILE.
000109     SELECT DATAF ASSIGN TO DATAFILE
                  ORGANIZATION IS INDEXED
                  ACCESS IS SEQUENTIAL
                  RECORD KEY IS DATA-ACCT-CODE OF DATA-REC.
000110     SELECT NMOUT ASSIGN TO OUTREC.
000111     SELECT ERROUT ASSIGN TO ERRREC.
000112
000114 DATA DIVISION.
000115 FILE SECTION.
000116 FD TRNSF.
000117 01 TRANS-REC.
000118   05 TRANS-NUMBER     PIC 9(5).
000119   05 FILLER           PIC XX.
000120   05 TRANS-DATE.
000121     10 YY             PIC 99.
000122     10 MM             PIC 99.
000123     10 DD             PIC 99.
000124   05 FILLER           PIC XX.
000125   05 SBA-ACCT-CODE    PIC 9(5).
000126   05 FILLER           PIC XX.
000127   05 TRANS-TYPE       PIC X.
000128   05 FILLER           PIC XX.
000129   05 TRANS-AMOUNT     PIC 9(6)V99.
000130   05 FILLER           PIC X(47).
000131 FD DATAF.
000132 01 DATA-REC.
000133   05 DATA-BRCH-CODE   PIC X(3).
000134   05 FILLER           PIC XX.
000135   05 DATA-ACCT-CODE   PIC 9(5).
000136   05 FILLER           PIC XX.
000137   05 DATA-CUST-NAME   PIC X(24).
000138   05 FILLER           PIC XX.
000140   05 DATA-CURR-BAL    PIC 9(6)V99.
000141   05 FILLER           PIC XX.
000143   05 DATA-BRCH-LOCT   PIC X(15).
000144   05 FILLER           PIC XX.
000146   05 DATA-BRCH-MGR-ID PIC 9(8).
000147   05 FILLER           PIC X(7).
000148 FD NMOUT.
000149 01 OUT-REC            PIC X(80).
000150 FD ERROUT.
000151 01 ERR-REC            PIC X(80).
000152
000153 WORKING-STORAGE SECTION.
000154 01 NM-REP.
000155   05 S-NO             PIC 9(5).
000156   05 FILLER           PIC X VALUE SPACE.
000157   05 CUST-NAME        PIC X(24).
000158   05 FILLER           PIC X VALUE SPACE.
000159   05 ACCT-CODE        PIC 9(5).
000160   05 FILLER           PIC X VALUE SPACE.
000161   05 OPEN-BAL         PIC 9(6)V99.
000162   05 FILLER           PIC X VALUE SPACE.
000163   05 TRANS-DATE.
000165     10 YY             PIC 99.
000166     10 FILLER         PIC X VALUE '/'.
000167     10 MM             PIC 99.
000168     10 FILLER         PIC X VALUE '/'.
000169     10 DD             PIC 99.
000170   05 FILLER           PIC X VALUE SPACE.
000171   05 TRANS-NO         PIC 9(5).
000172   05 FILLER           PIC X VALUE SPACE.
000173   05 TRANS-TYPE       PIC X.
000174   05 FILLER           PIC X VALUE SPACE.
000175   05 TRANS-AMT        PIC 9(6)V99.
000176   05 FILLER           PIC X VALUE SPACE.
000177   05 CLOSING-BAL      PIC 9(6)V99.
000178 01 ERR-REP.
000179   05 ACCT-CODE        PIC 9(5).
000180   05 FILLER           PIC X(6) VALUE SPACES.
000181   05 CUST-NAME        PIC X(24).
000182   05 FILLER           PIC XX VALUE SPACES.
000183   05 TRANS-NO         PIC 9(5).
000184   05 FILLER           PIC X(9) VALUE SPACES.
000185   05 ERR-DSCRPT       PIC X(29).
000186 01 ERR-HEADING.
000187   05 FILLER           PIC X(9) VALUE 'ACCT-CODE'.
000188   05 FILLER           PIC X(2) VALUE SPACES.
000189   05 FILLER           PIC X(13) VALUE 'CUSTOMER NAME'.
000190   05 FILLER           PIC X(13) VALUE SPACES.
000191   05 FILLER           PIC X(12) VALUE 'TRANS-NUMBER'.
000192   05 FILLER           PIC X(2) VALUE SPACES.
000193   05 FILLER           PIC X(17) VALUE 'ERROR-DESCRIPTION'.
000194   05 FILLER           PIC X(12) VALUE SPACES.
000195 01 OUTPUT-HEADING-1.
000196   05 FILLER           PIC X(31) VALUE SPACES.
000197   05 FILLER           PIC X(18) VALUE 'ALLUSRS TRUST BANK'.
000198   05 FILLER           PIC X(31) VALUE SPACES.
000199 01 OUTPUT-HEADING-2.
000200   05 FILLER           PIC X(23) VALUE SPACES.
000201   05 FILLER           PIC X(34) VALUE
000201                         'SAVINGS BANK ACCOUNT WEEKLY REPORT'.
000202   05 FILLER           PIC X(24) VALUE SPACES.
000203 01 OUTPUT-HEADING-3.
000204   05 FILLER           PIC X(20) VALUE 'PRINT DATE AND TIME:'.
000205   05 PRINT-DATE.
000206     10 YY             PIC 99.
000207     10 FILLER         PIC X VALUE '/'.
000208     10 MM             PIC 99.
000209     10 FILLER         PIC X VALUE '/'.
000210     10 DD             PIC 99.
000211   05 FILLER           PIC X VALUE SPACE.
000212   05 PRINT-TIME.
000213     10 HH             PIC 99.
000214     10 FILLER         PIC X VALUE ':'.
000215     10 MIN            PIC 99.
000216     10 FILLER         PIC X VALUE ':'.
000217     10 SS             PIC 99.
000218   05 FILLER           PIC X(32) VALUE SPACES.
000219   05 FILLER           PIC X(8) VALUE 'PAGE NO:'.
000220   05 PAGE-NO          PIC 9(3) VALUE ZERO.
000221 01 OUTPUT-HEADING-4.
000222   05 FILLER           PIC X(5) VALUE 'S.NO.'.
000223   05 FILLER           PIC X VALUE SPACE.
000224   05 FILLER           PIC X(13) VALUE 'CUSTOMER NAME'.
000225   05 FILLER           PIC X(12) VALUE SPACE.
000226   05 FILLER           PIC X(5) VALUE 'ACCT#'.
000227   05 FILLER           PIC X VALUE SPACE.
000228   05 FILLER           PIC X(8) VALUE 'OPEN-BAL'.
000229   05 FILLER           PIC X VALUE SPACE.
000230   05 FILLER           PIC X(8) VALUE 'TRNSDATE'.
000235   05 FILLER           PIC X VALUE SPACE.
000236   05 FILLER           PIC X(5) VALUE 'TRNS#'.
000237   05 FILLER           PIC X VALUE SPACE.
000238   05 FILLER           PIC X VALUE 'T'.
000239   05 FILLER           PIC X VALUE SPACE.
000240   05 FILLER           PIC X(8) VALUE 'TRNS-AMT'.
000241   05 FILLER           PIC X VALUE SPACE.
000242   05 FILLER           PIC X(8) VALUE 'CLSE-BAL'.
000243 01 WS-DATE.
000244   05 YY               PIC 99.
000245   05 MM               PIC 99.
000246   05 DD               PIC 99.
000247 01 WS-TIME.
000248   05 HH               PIC 99.
000249   05 MIN              PIC 99.
000250   05 SS               PIC 99.
000251   05 TT               PIC 99.
000252 01 DOTTED-LINE.
000253   05 DOTS             PIC X VALUE '-' OCCURS 80 TIMES.
000254 01 PAGE-SEPERATOR.
000255   05 SEPS             PIC X VALUE '*' OCCURS 79 TIMES.
000256 01 EOF-TRANS          PIC A VALUE 'N'.
000257 01 EOF-DATA           PIC A VALUE 'N'.
000258 01 TRANS-BUFF.
000259   05 DATA-BRCH-CODE   PIC X(3).
000260   05 DATA-ACCT-CODE   PIC 9(5).
000261   05 DATA-CUST-NAME   PIC X(24).
000262   05 DATA-CURR-BAL    PIC S9(6)V99.
000263   05 BUFF-OPEN-BAL    PIC 9(6)V99.
000264   05 DATA-BRCH-LOCT   PIC X(15).
000265   05 DATA-BRCH-MGR-ID PIC 9(8).
000266 01 TRANS-VALID        PIC X VALUE 'N'.
000267 01 DIFFER-ID-APPEARS  PIC X VALUE 'N'.
000268 01 REC-FOUND-IN-DATAF PIC X VALUE 'N'.
000269 01 EDIT-CURR          PIC -9(6)V99.
000270 01 LINE-NO            PIC 9(3) VALUE ZERO.
000271 01 TEMP               PIC S9(6)V99.
000272
000273 PROCEDURE DIVISION.
000274 A000-MAIN-PARA.
000275     DISPLAY 'THE MAIN PROGRAM STARTS HERE'.
000276     ACCEPT WS-DATE FROM DATE.
000277     PERFORM A100-OPEN-FILES.
000278* GENERATING THE HEADING OF ERROR REPORT.
000279     WRITE ERR-REC FROM ERR-HEADING.
000280     WRITE ERR-REC FROM DOTTED-LINE.
000281* THE HEADING OF ERROR REPORT GENERATED.
000282* INITIALIZE PAGE NUMBER.
000283     MOVE ZERO TO PAGE-NO.
000284     MOVE ZERO TO S-NO.
000285     PERFORM A200-DO-TRANS.
000286     PERFORM A400-CLOSE-FILES.
000287 A000-EXIT.
000288     EXIT.
000289     STOP RUN.
000290
000291 A100-OPEN-FILES.
000292     OPEN INPUT TRNSF.
000293     OPEN INPUT DATAF.
000294     OPEN OUTPUT NMOUT.
000295     OPEN OUTPUT ERROUT.
000296 A100-EXIT.
000297     EXIT.
000298
000299 A200-DO-TRANS.
000300     DISPLAY 'DOING TRANS'.
000301     PERFORM A600-REF-BUFF.
000302     MOVE 'N' TO EOF-TRANS.
000303     PERFORM A210-READ-TRNS.
000304     IF EOF-TRANS = 'Y'
000305         DISPLAY 'NO DATA IN TRANSACTION FILE!'
000306         STOP RUN
000307     END-IF.
000308     MOVE 'Y' TO DIFFER-ID-APPEARS.
000309     PERFORM A211-OUTSIDE-LOOP UNTIL EOF-TRANS = 'Y'
000310     PERFORM A300-EOF-TRANS.
000311 A200-EXIT.
000312     EXIT.
000313
000314 A210-READ-TRNS.
000315     READ TRNSF AT END MOVE 'Y' TO EOF-TRANS.
000316 A210-EXIT.
000317     EXIT.
000318
000319 A211-OUTSIDE-LOOP.
000320     DISPLAY 'PERFORMING OUTSIDE LOOP'.
000321     IF DIFFER-ID-APPEARS = 'Y'
000322*        REFRESHING THE BUFF.
000323         PERFORM A600-REF-BUFF
000324*     HERE DO THE REPORT WITH THE BUFF
000325*     HERE INITIALIZE THE BUFFER WITH THE INFO IN DATAFILE.
000326*     IF ACCT-ID NOT FOUND IN DATA FILE, DO AN ERR-REPORT.
000327*        START DATAF-------COMMENTED OUT BECAUSE
000328*     START IS NOT SUPPORTED HERE. USING CLOSE AND OPEN INSTEAD.
000329         CLOSE DATAF
000330         OPEN INPUT DATAF
000331         MOVE 'N' TO EOF-DATA
000332* RESET THE FILE POINTER TO THE BEGINING OF DATAFILE.
000333         MOVE 'N' TO REC-FOUND-IN-DATAF
000334         PERFORM A215-FIND-REC-IN-DATAF UNTIL
000335               REC-FOUND-IN-DATAF = 'Y' OR EOF-DATA = 'Y'
000336         IF REC-FOUND-IN-DATAF NOT = 'Y'
000337             MOVE 'ACCT-ID NOT FOUND IN DATAFILE' TO ERR-DSCRPT
000338             PERFORM A500-ERR-REPORT
000339*      BYPASSING...
000340             MOVE 'N' TO DIFFER-ID-APPEARS
000341             MOVE SBA-ACCT-CODE TO DATA-ACCT-CODE OF TRANS-BUFF
000342             PERFORM UNTIL DIFFER-ID-APPEARS = 'Y'
000343                           OR EOF-TRANS = 'Y'
000344                 PERFORM A210-READ-TRNS
000345                 IF SBA-ACCT-CODE NOT =
000346                         DATA-ACCT-CODE OF TRANS-BUFF
000347                     MOVE 'Y' TO DIFFER-ID-APPEARS
000348                 END-IF
000349             END-PERFORM
000350*      BYPASSED.
000351         ELSE
000352*      THE CONDITION OF REC-FOUND-IN-DATAF = 'Y'
000353             MOVE CORR DATA-REC TO TRANS-BUFF
000354             MOVE DATA-CURR-BAL OF TRANS-BUFF TO BUFF-OPEN-BAL
000355*            BUFF INITIALIZED
000356             MOVE 'N' TO DIFFER-ID-APPEARS
000357             PERFORM A220-INSIDE-LOOP UNTIL EOF-TRANS = 'Y' OR
000358                     DIFFER-ID-APPEARS = 'Y'
000359         END-IF
000360     END-IF.
000361 A211-EXIT.
000362     EXIT.
000363
000364 A215-FIND-REC-IN-DATAF.
000365     READ DATAF AT END MOVE 'Y' TO EOF-DATA.
000366     IF DATA-ACCT-CODE OF DATA-REC = SBA-ACCT-CODE
000367         MOVE 'Y' TO REC-FOUND-IN-DATAF
000368     END-IF.
000369 A215-EXIT.
000370     EXIT.
000371
000372 A220-INSIDE-LOOP.
000373     DISPLAY 'PERFORMING INSIDE LOOP'.
000374     MOVE 'N' TO TRANS-VALID.
000375     DISPLAY 'BEFORE VALIDATION:' TRANS-BUFF.
000376     DISPLAY TRANS-REC.
000377     DISPLAY 'END OF VALIDATION DISPLAYING'.
000378     PERFORM A221-VALIDATE.
000379     IF TRANS-VALID NOT = 'Y'
000380*HERE THE VALIDATION INCLUDE THE BALANCE>=250 VALIDATION
000381         PERFORM A500-ERR-REPORT
000400         PERFORM A210-READ-TRNS
000401         IF SBA-ACCT-CODE NOT = DATA-ACCT-CODE OF TRANS-BUFF
000402             MOVE 'Y' TO DIFFER-ID-APPEARS
000403         END-IF
000382*     BYPASSING....
000383*        PERFORM UNTIL DIFFER-ID-APPEARS = 'Y' OR EOF-TRANS = 'Y'
000384*            PERFORM A210-READ-TRNS
000385*            IF SBA-ACCT-CODE NOT = DATA-ACCT-CODE OF TRANS-BUFF
000386*                MOVE 'Y' TO DIFFER-ID-APPEARS
000387*            END-IF
000388*        END-PERFORM
000389*     BYPASSED.
000390     ELSE
000391*THE TRANSACTION IS VALID
000392         IF TRANS-TYPE OF TRANS-REC = 'D'
000393             ADD TRANS-AMOUNT TO DATA-CURR-BAL OF TRANS-BUFF
000394         ELSE
000395             SUBTRACT TRANS-AMOUNT FROM
000396                DATA-CURR-BAL OF TRANS-BUFF
000397         END-IF
000398         PERFORM A230-NORMAL-REPORT
000399*        READ NEXT
000400         PERFORM A210-READ-TRNS
000401         IF SBA-ACCT-CODE NOT = DATA-ACCT-CODE OF TRANS-BUFF
000402             MOVE 'Y' TO DIFFER-ID-APPEARS
000403         END-IF
000404     END-IF.
000405 A220-EXIT.
000406     EXIT.
000407
000408 A221-VALIDATE.
000410     MOVE 'Y' TO TRANS-VALID.
000411     IF TRANS-NUMBER OF TRANS-REC NOT NUMERIC
000412         MOVE 'TRANS NUMBER NOT NUMERIC' TO ERR-DSCRPT
000413         MOVE 'N' TO TRANS-VALID
000414     END-IF.
000415     IF TRANS-VALID = 'Y' AND
000415        YY OF TRANS-DATE OF TRANS-REC NOT NUMERIC
000416         MOVE 'TRANS YEAR NOT VALID' TO ERR-DSCRPT
000417         MOVE 'N' TO TRANS-VALID
000418     END-IF.
000419     IF TRANS-VALID = 'Y' AND
000419        MM OF TRANS-DATE OF TRANS-REC NOT NUMERIC
000420        OR MM OF TRANS-DATE OF TRANS-REC > 12
000421        OR MM OF TRANS-DATE OF TRANS-REC < 1
000422         MOVE 'TRANS MONTH NOT VALID' TO ERR-DSCRPT
000423         MOVE 'N' TO TRANS-VALID
000424     END-IF.
000425     IF TRANS-VALID = 'Y' AND
000425        DD OF TRANS-DATE OF TRANS-REC NOT NUMERIC
000426        OR DD OF TRANS-DATE OF TRANS-REC > 31
000427        OR DD OF TRANS-DATE OF TRANS-REC < 1
000428         MOVE 'TRANS DAY NOT VALID' TO ERR-DSCRPT
000429         MOVE 'N' TO TRANS-VALID
000430     END-IF.
000440*   VALIDATE THE FUTURE DATE
000441     IF TRANS-VALID = 'Y' AND
000441        WS-DATE < TRANS-DATE OF TRANS-REC
000442         MOVE 'TRANS DAY IS FUTURE' TO ERR-DSCRPT
000443         MOVE 'N' TO TRANS-VALID
000444     END-IF.
000445     IF TRANS-VALID = 'Y' AND
000445        SBA-ACCT-CODE NOT NUMERIC
000446        OR SBA-ACCT-CODE < 10001
000448         MOVE 'TRANS ACCOUNT CODE NOT VALID' TO ERR-DSCRPT
000449         MOVE 'N' TO TRANS-VALID
000450     END-IF.
000451     IF TRANS-VALID = 'Y' AND
000451        TRANS-TYPE OF TRANS-REC NOT = 'D'
000452        AND TRANS-TYPE OF TRANS-REC NOT = 'W'
000453         MOVE 'TRANS TYPE NOT D OR W' TO ERR-DSCRPT
000454         MOVE 'N' TO TRANS-VALID
000455     END-IF.
000456     IF TRANS-VALID = 'Y' AND
000456        TRANS-AMOUNT OF TRANS-REC <= 0
000457         MOVE 'TRANS AMOUNT LESS THAN 0' TO ERR-DSCRPT
000458         MOVE 'N' TO TRANS-VALID
000459     END-IF.
000460     IF TRANS-VALID = 'Y' AND
000460        DATA-BRCH-CODE OF TRANS-BUFF = SPACES
000461         MOVE 'BRANCH CODE IS ALL SPACES' TO ERR-DSCRPT
000462         MOVE 'N' TO TRANS-VALID
000463     END-IF.
000464     IF TRANS-VALID = 'Y' AND
000464        DATA-CUST-NAME OF TRANS-BUFF = SPACES
000465         MOVE 'CUSTOMER NAME IS ALL SPACES' TO ERR-DSCRPT
000466         MOVE 'N' TO TRANS-VALID
000467     END-IF.
000468     IF TRANS-VALID = 'Y' AND
000468        DATA-CURR-BAL OF TRANS-BUFF < 250
000469            OR BUFF-OPEN-BAL OF TRANS-BUFF < 250
000470         MOVE 'BALANCE LESS THAN 250' TO ERR-DSCRPT
000471         MOVE 'N' TO TRANS-VALID
000472     END-IF.
000473     IF TRANS-VALID = 'Y' AND
000473        DATA-BRCH-LOCT OF TRANS-BUFF = SPACES
000474         MOVE 'BRANCH LOCATION IS ALL SPACES' TO ERR-DSCRPT
000475         MOVE 'N' TO TRANS-VALID
000476     END-IF.
000477     IF TRANS-VALID = 'Y' AND
000477        TRANS-TYPE OF TRANS-REC = 'W'
000478         COMPUTE TEMP = DATA-CURR-BAL OF TRANS-BUFF - TRANS-AMOUNT
000479         IF TEMP < 250
000480             MOVE 'BALANCE LESS THAN 250' TO ERR-DSCRPT
000481             MOVE 'N' TO TRANS-VALID
000482         END-IF
000483     END-IF.
000484 A221-EXIT.
000485     EXIT.
000486
000487 A230-NORMAL-REPORT.
000488     IF LINE-NO = ZERO
000489*        PRINT HEADERS
000490         WRITE OUT-REC FROM OUTPUT-HEADING-1
000491         WRITE OUT-REC FROM OUTPUT-HEADING-2
000492         ACCEPT WS-TIME FROM TIME
000493         MOVE CORR WS-DATE TO PRINT-DATE
000494         MOVE CORR WS-TIME TO PRINT-TIME
000495         ADD 1 TO PAGE-NO
000496         WRITE OUT-REC FROM OUTPUT-HEADING-3
000497         WRITE OUT-REC FROM DOTTED-LINE
000498*        PRINT TITLES HERE
000499         WRITE OUT-REC FROM OUTPUT-HEADING-4
000500         WRITE OUT-REC FROM DOTTED-LINE
000501*        HEADERS PRINTED
000502         MOVE 6 TO LINE-NO
000503         PERFORM A700-INIT-NM-REP
000504         WRITE OUT-REC FROM NM-REP
000505         ADD 1 TO LINE-NO
000506     ELSE
000507         PERFORM A700-INIT-NM-REP
000508         WRITE OUT-REC FROM NM-REP
000509         ADD 1 TO LINE-NO
000510*      SEE WHETHER THE PAGE IS FULL
000511         IF LINE-NO >= 29
000512             MOVE ZERO TO LINE-NO
000513             WRITE OUT-REC FROM DOTTED-LINE
000514*                  BEFORE ADVANCING PAGE
000515         END-IF
000516     END-IF.
000517 A230-EXIT.
000518     EXIT.
000519
000520 A300-EOF-TRANS.
000521     DISPLAY 'END OF TRANSACTION FILE REACHED'.
000522 A300-EXIT.
000523     EXIT.
000524
000525 A400-CLOSE-FILES.
000526     CLOSE TRNSF.
000527     CLOSE DATAF.
000528     CLOSE NMOUT.
000529     CLOSE ERROUT.
000530 A400-EXIT.
000531     EXIT.
000532
000533 A500-ERR-REPORT.
000534     MOVE SBA-ACCT-CODE TO ACCT-CODE OF ERR-REP.
000535     MOVE DATA-CUST-NAME OF TRANS-BUFF TO CUST-NAME OF ERR-REP.
000536     MOVE TRANS-NUMBER OF TRANS-REC TO TRANS-NO OF ERR-REP.
000537     WRITE ERR-REC FROM ERR-REP.
000538 A500-EXIT.
000539     EXIT.
000540
000541 A600-REF-BUFF.
000542     MOVE SPACES TO DATA-BRCH-CODE OF TRANS-BUFF.
000543     MOVE ZEROES TO DATA-ACCT-CODE OF TRANS-BUFF.
000544     MOVE SPACES TO DATA-CUST-NAME OF TRANS-BUFF.
000545     MOVE ZEROES TO DATA-CURR-BAL OF TRANS-BUFF.
000546     MOVE ZEROES TO BUFF-OPEN-BAL OF TRANS-BUFF.
000547     MOVE SPACES TO DATA-BRCH-LOCT OF TRANS-BUFF.
000548     MOVE ZEROES TO DATA-BRCH-MGR-ID OF TRANS-BUFF.
000549 A600-EXIT.
000550     EXIT.
000551
000552 A700-INIT-NM-REP.
000553     ADD 1 TO S-NO.
000554     MOVE DATA-CUST-NAME OF TRANS-BUFF TO CUST-NAME OF NM-REP.
000555     MOVE DATA-ACCT-CODE OF TRANS-BUFF TO ACCT-CODE OF NM-REP.
000556     MOVE BUFF-OPEN-BAL OF TRANS-BUFF TO OPEN-BAL OF NM-REP.
000557     MOVE CORR TRANS-DATE OF TRANS-REC TO TRANS-DATE OF NM-REP.
000558     MOVE TRANS-NUMBER OF TRANS-REC TO TRANS-NO OF NM-REP.
000559     MOVE TRANS-TYPE OF TRANS-REC TO TRANS-TYPE OF NM-REP.
000560     MOVE TRANS-AMOUNT OF TRANS-REC TO TRANS-AMT OF NM-REP.
000561     MOVE DATA-CURR-BAL OF TRANS-BUFF TO CLOSING-BAL OF NM-REP.
000562 A700-EXIT.
000563     EXIT.
000564
000600 END PROGRAM CASEMAIN.