from mari@pi mari@pi on 2008-05-19 11:22 tags programming , mainframe
wait..Voting.. bad good
ID DIVISION.
PROGRAM-ID MAICHDG.
*-------------------------------------------------
*-    YPOLOGISMOS  CH-DIGIT  T.K ME MODULUS 10
*-        ​​​​      COMMO​N-A​REA
*-        ​​​​ 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.