📄 rptdd705
字号:
MOVE 0 TO HRD-FILLTO
MOVE 1 TO HRD-KEY-INDEX
PERFORM CUST-EDIT-TOTAL-HEADER THRU
CUST-EDIT-TOTAL-HEADER-EXIT
PERFORM HRD-CHECK-SUBTOTAL THRU
HRD-CHECK-SUBTOTAL-EXIT
END-IF
IF HRD-KEY-BREAK <= 0 THEN
MOVE 0 TO HRD-STICK
MOVE 0 TO HRD-FILLTO
MOVE 0 TO HRD-KEY-INDEX
PERFORM CUST-EDIT-TOTAL-HEADER THRU
CUST-EDIT-TOTAL-HEADER-EXIT
PERFORM HRD-CHECK-SUBTOTAL THRU
HRD-CHECK-SUBTOTAL-EXIT
END-IF
.
HRD-OUTPUT-TOTAL-EXIT.
EXIT.
HRD-TURN-PAGE.
IF ( HRD-LC = 0 ) AND ( HRD-LC2 = 0 ) THEN
GO TO HRD-TURN-PAGE-EXIT
END-IF
ADD 1 TO HRD-PAGE-NO-1
MOVE 0 TO HRD-LC
MOVE 0 TO HRD-LC2
.
HRD-TURN-PAGE-EXIT.
EXIT.
HRD-CHECK-SUBTOTAL.
COMPUTE HRD-TMP-I = HRD-LC + HRD-STICK + 0
IF ( ( HRD-FILLTO NOT = 0 ) AND ( HRD-LC > HRD-FILLTO ) )
OR ( HRD-TMP-I > 60 ) THEN
IF HRD-BROKEN-DETAIL = 'X' THEN
MOVE 'Y' TO HRD-BROKEN-DETAIL
END-IF
PERFORM HRD-OUTPUT-SUBTOTAL THRU
HRD-OUTPUT-SUBTOTAL-EXIT
PERFORM HRD-TURN-PAGE THRU
HRD-TURN-PAGE-EXIT
PERFORM HRD-OUTPUT-SUBHEADER THRU
HRD-OUTPUT-SUBHEADER-EXIT
END-IF
IF HRD-FILLTO NOT = 0 THEN
MOVE 1 TO HRD-TMP-I
PERFORM UNTIL HRD-TMP-I >= HRD-FILLTO
MOVE SPACE TO FOUT-LINE
PERFORM CR-WRITE-LINE THRU
CR-WRITE-LINE-EXIT
END-PERFORM
END-IF
.
HRD-CHECK-SUBTOTAL-EXIT.
EXIT.
*
HRD-OUTPUT-SUBHEADER.
MOVE HRD-REPORT-ID TO HRD-C-RPT-ID
MOVE HRD-REPORT-NAME TO HRD-C-RPT-NAME
MOVE HRD-REPORT-NAME-LINE TO HRD-C-RPT-NAME-LINE
MOVE HRD-CR-BR-NAME TO HRD-C-BR-NAME
MOVE HRD-CR-AC-DATE TO HRD-C-AC-DATE
MOVE HRD-THIS-CCY-CODE(4 :) TO HRD-C-CCY
MOVE HRD-PAGE-NO-1 TO HRD-C-PAGE
PERFORM CUST-EDIT-SUBHEADER THRU
CUST-EDIT-SUBHEADER-EXIT
MOVE HRD-THIS-BR TO HRD-L1-BR
MOVE HRD-C-RPT-ID TO HRD-L1-RPT-ID
MOVE HRD-L1 TO FOUT-LINE
PERFORM CR-WRITE-LINE THRU
CR-WRITE-LINE-EXIT
MOVE HRD-C-RPT-NAME TO HRD-L2-RPT-NAME
* CALL 'SCSSGADR' USING HRD-L2-RPT-NAME, HRD-JUST-ADDR
MOVE LENGTH OF HRD-L2-RPT-NAME TO HRD-JUST-LEN
PERFORM CR-CENTER-JUSTIFY THRU
CR-CENTER-JUSTIFY-EXIT
MOVE HRD-L2 TO FOUT-LINE
PERFORM CR-WRITE-LINE THRU
CR-WRITE-LINE-EXIT
MOVE HRD-C-RPT-NAME-LINE TO HRD-L3-RPT-NAME-LINE
* CALL 'SCSSGADR' USING HRD-L3-RPT-NAME-LINE, HRD-JUST-ADDR
MOVE LENGTH OF HRD-L3-RPT-NAME-LINE TO HRD-JUST-LEN
PERFORM CR-CENTER-JUSTIFY THRU
CR-CENTER-JUSTIFY-EXIT
MOVE HRD-L3 TO FOUT-LINE
PERFORM CR-WRITE-LINE THRU
CR-WRITE-LINE-EXIT
MOVE HRD-C-AC-DATE TO HRD-L5-AC-DATE
MOVE HRD-C-BR-NAME TO HRD-L5-BR-NAME
MOVE HRD-C-CCY TO HRD-L5-CCY
MOVE HRD-C-PAGE TO HRD-L5-PAGE
MOVE HRD-L5 TO FOUT-LINE
PERFORM CR-WRITE-LINE THRU
CR-WRITE-LINE-EXIT
MOVE HRD-L6 TO FOUT-LINE
PERFORM CR-WRITE-LINE THRU
CR-WRITE-LINE-EXIT
MOVE HRD-L7 TO FOUT-LINE
PERFORM CR-WRITE-LINE THRU
CR-WRITE-LINE-EXIT
.
HRD-OUTPUT-SUBHEADER-EXIT.
EXIT.
*
HRD-OUTPUT-SUBTOTAL.
PERFORM CUST-EDIT-SUBTOTAL THRU
CUST-EDIT-SUBTOTAL-EXIT
.
HRD-OUTPUT-SUBTOTAL-EXIT.
EXIT.
*
******************************
* COMMON ROUTINE *
******************************
*
CR-CENTER-JUSTIFY.
SET ADDRESS OF HRD-JUST-STR TO HRD-JUST-ADDR
MOVE 0 TO HRD-JUST-FIRST
MOVE 0 TO HRD-JUST-LAST
MOVE 1 TO HRD-JUST-I
PERFORM UNTIL HRD-JUST-I > HRD-JUST-LEN
IF HRD-JUST-ARRAY(HRD-JUST-I) NOT = SPACE THEN
IF HRD-JUST-FIRST = 0 THEN
MOVE HRD-JUST-I TO HRD-JUST-FIRST
END-IF
MOVE HRD-JUST-I TO HRD-JUST-LAST
END-IF
ADD 1 TO HRD-JUST-I
END-PERFORM
COMPUTE HRD-JUST-STEP = HRD-JUST-FIRST - 1 -
( HRD-JUST-LEN - HRD-JUST-LAST +
HRD-JUST-FIRST - 1 ) / 2
IF HRD-JUST-FIRST = 0 OR
HRD-JUST-STEP = 0 THEN
GO TO CR-CENTER-JUSTIFY-EXIT
END-IF
IF HRD-JUST-STEP > 0 THEN
MOVE HRD-JUST-FIRST TO HRD-JUST-I
PERFORM UNTIL HRD-JUST-I > HRD-JUST-LAST
COMPUTE HRD-JUST-J = HRD-JUST-I -
HRD-JUST-STEP
MOVE HRD-JUST-ARRAY(HRD-JUST-I) TO
HRD-JUST-ARRAY(HRD-JUST-J)
MOVE SPACE TO
HRD-JUST-ARRAY(HRD-JUST-I)
ADD 1 TO HRD-JUST-I
END-PERFORM
END-IF
IF HRD-JUST-STEP < 0 THEN
MOVE HRD-JUST-LAST TO HRD-JUST-I
PERFORM UNTIL HRD-JUST-I < HRD-JUST-FIRST
COMPUTE HRD-JUST-J = HRD-JUST-I -
HRD-JUST-STEP
MOVE HRD-JUST-ARRAY(HRD-JUST-I) TO
HRD-JUST-ARRAY(HRD-JUST-J)
MOVE SPACE TO
HRD-JUST-ARRAY(HRD-JUST-I)
SUBTRACT 1 FROM HRD-JUST-I
END-PERFORM
END-IF
.
CR-CENTER-JUSTIFY-EXIT.
EXIT.
*
CR-PGM-EXIT.
IF HRD-FIN-OPENED THEN
CLOSE FIN
END-IF
IF HRD-FOUT-OPENED THEN
CLOSE FOUT
END-IF
PERFORM CUST-PGM-EXIT THRU
CUST-PGM-EXIT-EXIT
GOBACK
.
CR-PGM-EXIT-EXIT.
EXIT.
*
CR-ERROR.
INITIALIZE SCCBERR
EVALUATE TRUE
WHEN HRD-CR-ERR-OPEN-FIN
SET BERR-OPEN TO TRUE
MOVE 'FIN' TO BERR-NAME
MOVE WS-FIN-STS TO BERR-NO
WHEN HRD-CR-ERR-OPEN-FOUT
SET BERR-OPEN TO TRUE
MOVE 'FOUT' TO BERR-NAME
MOVE WS-FOUT-STS TO BERR-NO
WHEN HRD-CR-ERR-READ-FIN
SET BERR-READ TO TRUE
MOVE 'FIN' TO BERR-NAME
MOVE WS-FIN-STS TO BERR-NO
MOVE FIN-KEY TO BERR-KEY-OR-OTHER
WHEN HRD-CR-ERR-WRITE-FOUT
SET BERR-WRITE TO TRUE
MOVE 'FOUT' TO BERR-NAME
MOVE WS-FOUT-STS TO BERR-NO
WHEN HRD-CR-ERR-G-ARR-FULL
SET BERR-OTHER TO TRUE
MOVE 'FOUT' TO BERR-NAME
MOVE WS-FOUT-STS TO BERR-NO
WHEN HRD-CR-ERR-CALL-JPRM
SET BERR-CALL TO TRUE
MOVE PGM-SCSBJPRM TO BERR-NAME
MOVE RETURN-CODE TO BERR-NO
MOVE SCRJPRM TO BERR-KEY-OR-OTHER
WHEN HRD-CR-ERR-CALL-RBDT
SET BERR-CALL TO TRUE
MOVE PGM-SCSBRBDT TO BERR-NAME
MOVE RETURN-CODE TO BERR-NO
MOVE SCRRBDT TO BERR-KEY-OR-OTHER
END-EVALUATE
SET BERR-ERROR TO TRUE
PERFORM S00-APP-ERR-PROC
PERFORM CR-PGM-EXIT THRU
CR-PGM-EXIT-EXIT
.
CR-ERROR-EXIT.
EXIT.
*
CR-GET-BR-INFO.
MOVE HRD-CR-BR TO RBDT-BR
CALL PGM-SCSBRBDT USING SCRRBDT
IF ( RETURN-CODE NOT = ZERO ) OR ( RBDT-RC NOT = ZERO ) THEN
SET HRD-CR-ERR-CALL-RBDT TO TRUE
PERFORM CR-ERROR THRU
CR-ERROR-EXIT
END-IF
MOVE RBDT-BR-NAME TO HRD-CR-BR-NAME
MOVE RBDT-SUP-BR TO HRD-CR-UPORG
.
CR-GET-BR-INFO-EXIT.
EXIT.
*
CR-GET-AC-DATE.
CALL PGM-SCSBJPRM USING SCRJPRM
IF RETURN-CODE NOT = ZERO THEN
SET HRD-CR-ERR-CALL-JPRM TO TRUE
PERFORM CR-ERROR THRU
CR-ERROR-EXIT
END-IF
MOVE JPRM-AC-DATE TO HRD-CR-AC-DATE
.
CR-GET-AC-DATE-EXIT.
EXIT.
*
CR-WRITE-LINE.
IF ( HRD-LC = 0 ) AND ( HRD-LC2 = 0 ) THEN
MOVE '1' TO FOUT-NEW-PAGE
ELSE
MOVE ' ' TO FOUT-NEW-PAGE
END-IF
IF FOUT-LINE(1 : 4) = '@OD@' THEN
ADD 1 TO HRD-LC2
ELSE
ADD 1 TO HRD-LC
END-IF
WRITE FOUT-REC
EVALUATE WS-FOUT-STS
WHEN FSTS-NORMAL
CONTINUE
WHEN OTHER
SET HRD-CR-ERR-WRITE-FOUT TO TRUE
PERFORM CR-ERROR THRU
CR-ERROR-EXIT
END-EVALUATE
.
CR-WRITE-LINE-EXIT.
EXIT.
*
******************************
*SYSTEM ERROR PROCESS(PUBLIC)*
******************************
* COPY SCSPBERR.
*
******************************
* CUSTOM PROCESS *
******************************
CUST-INIT.
CONTINUE
.
CUST-INIT-EXIT.
EXIT.
*
CUST-PGM-EXIT.
CONTINUE
.
CUST-PGM-EXIT-EXIT.
EXIT.
*
CUST-EDIT-HEADER.
CONTINUE
.
CUST-EDIT-HEADER-EXIT.
EXIT.
*
CUST-EDIT-DATA.
CONTINUE
.
CUST-EDIT-DATA-EXIT.
EXIT.
*
CUST-EDIT-TOTAL-HEADER.
CONTINUE
.
CUST-EDIT-TOTAL-HEADER-EXIT.
EXIT.
*
CUST-EDIT-TOTAL-DATA.
CONTINUE
.
CUST-EDIT-TOTAL-DATA-EXIT.
EXIT.
*
CUST-EDIT-TOTAL-TOTAL.
CONTINUE
.
CUST-EDIT-TOTAL-TOTAL-EXIT.
EXIT.
*
CUST-EDIT-SUBHEADER.
CONTINUE
.
CUST-EDIT-SUBHEADER-EXIT.
EXIT.
*
CUST-EDIT-SUBTOTAL.
CONTINUE
.
CUST-EDIT-SUBTOTAL-EXIT.
EXIT.
S00-APP-ERR-PROC.
CONTINUE.
*
******************************
END PROGRAM RPTDD705.
******************************
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -