ID DIVISION.
PROGRAM-ID MAICHDG.
*-------------------------------------------------
*- YPOLOGISMOS CH-DIGIT T.K ME MODULUS 10
*- COMMON-AREA
*- IN ARIQMOS 9(5)
*- OUT CHDG5-N 9
*- ME-15-07-2006
*-------------------------------------------------
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
DECIMAL-POINT IS COMMA.
DATA DIVISION.
WORKING-STORAGE SECTION.
77 S1 PIC 9 VALUE ZERO.
77 SW PIC 9 VALUE ZERO.
*-
01 AR-IN-X.
05 AR-TK PIC 9.
05 AR-SEL PIC 9(4).
*-
01 AR-X.
05 AR-F PIC 9 OCCURS 5 TIMES.
01 AR-N REDEFINES AR-X PIC 9(5).
*-
01 RES-X.
05 RES-1 PIC 9.
05 RES-2 PIC 9.
01 RES-N REDEFINES RES-X PIC 99.
*-
01 AC-X.
05 F PIC X.
05 AC-LAST PIC 9.
01 AC-N REDEFINES AC-X PIC 9(2).
*---------------------------------------------------
LINKAGE SECTION.
COPY RMAICHDG.
PROCEDURE DIVISION USING RMAICHDG.
*---------------------------------
*-
MOVE CHDG5-TK TO AR-TK
MOVE CHDG5-SEL TO AR-SEL
*-
MOVE AR-IN-X TO AR-X
*-
MOVE 1 TO SW
MOVE ZERO TO RES-N AC-N
*-
PERFORM VARYING S1 FROM 5 BY -1 UNTIL S1 = 0
IF SW = 1
MOVE 3TOSW
ELSE
MOVE 1TOSW
END-IF
COMPUTE RES-N = AR-F (S1) * SW
COMPUTE AC-N = AC-N + RES-N
END-PERFORM
*-
COMPUTE RES-N = 10 - AC-LAST
*-
COMPUTE CHDG5-N = RES-2
*-
MOVE 0 TO RETURN-CODE
GOBACK.