//PROGRAM JOB CLASS=A,MSGCLASS=H 00000107 //JOBPROC DD DSN=HERC01.KICKSSYS.V1R5M0.PROCLIB,DISP=SHR 00000206 // EXEC K2KCOBCL 00000305 //COPY.SYSUT1 DD * 00000404 ID DIVISION. 00000504 PROGRAM-ID. RRPCALC. 00000632 ENVIRONMENT DIVISION. 00000725 DATA DIVISION. 00000804 WORKING-STORAGE SECTION. 00000904 * 00001034 01 PAR1 PIC 9(10). 00001144 01 PAR2 PIC 9(10). 00001244 01 NUMTXT PIC X(10). 00001345 01 NUMNUM REDEFINES NUMTXT PIC 9(10). 00001445 01 RESULT. 00001544 05 R-PAR1 PIC X(10) VALUE SPACE. 00001644 05 R-T1 PIC X VALUE SPACE. 00001744 05 R-TOP PIC X VALUE '_'. 00001844 05 R-T2 PIC X VALUE SPACE. 00001944 05 R-PAR2 PIC X(10). 00002045 05 R-T3 PIC XXX VALUE ' = '. 00002144 05 R-RES PIC X(18) VALUE SPACE. 00002245 * 00002338 01 MYCOMMAREA. 00002435 05 C-PARAM1 PIC X(10). 00002539 05 C-PARAM2 PIC X(10). 00002639 05 C-OPERTR PIC X(1). 00002735 05 C-FIRST PIC X(1). 00002838 * 00002934 COPY TESTMSD. 00003035 COPY DFHAID. 00003138 * 00003235 LINKAGE SECTION. 00003335 01 DFHCOMMAREA. 00003435 05 D-PARAM1 PIC X(10). 00003539 05 D-PARAM2 PIC X(10). 00003639 05 D-OPERTR PIC X(1). 00003735 05 D-FIRST PIC X(1). 00003835 * 00003935 PROCEDURE DIVISION. 00004004 IF EIBAID = DFHPF3 00004138 EXEC KICKS RETURN 00004238 END-EXEC. 00004338 * 00004438 MOVE DFHCOMMAREA TO MYCOMMAREA. 00004535 MOVE C-OPERTR TO OPERTRO. 00004635 * 00004744 IF EIBAID = DFHPF4 00004844 * ** DON'T TOUCH PARAM1O TO FORCE NUMERIC JUSTIF. 00004944 * ** DON'T TOUCH PARAM20 00005044 MOVE 'R' TO C-FIRST 00005144 ELSE 00005244 MOVE C-PARAM1 TO PARAM1O 00005344 MOVE C-PARAM2 TO PARAM2O. 00005444 * 00005536 IF C-FIRST NOT = 'S' 00005638 EXEC KICKS 00005736 SEND MAP('RRPCMAP') 00005836 MAPSET('TESTMSD') 00005936 ERASE 00006036 END-EXEC 00006136 MOVE 'S' TO C-FIRST 00006238 ELSE 00006338 EXEC KICKS 00006438 RECEIVE MAP('RRPCMAP') 00006538 MAPSET('TESTMSD') 00006638 INTO(RRPCMAPI) 00006738 END-EXEC 00006838 * 00006945 MOVE PARAM1I TO NUMTXT R-PAR1 00007045 EXAMINE R-PAR1 REPLACING LEADING '0' BY ' ' 00007145 MOVE NUMNUM TO PAR1 00007245 MOVE PARAM2I TO NUMTXT R-PAR2 00007345 EXAMINE R-PAR2 REPLACING LEADING '0' BY ' ' 00007445 MOVE NUMNUM TO PAR2 00007545 * 00007645 IF OPERTRI = '*' 00007745 MULTIPLY PAR1 BY PAR2 GIVING NUMNUM 00007845 ELSE IF OPERTRI = '/' 00007945 DIVIDE PAR1 BY PAR2 GIVING NUMNUM 00008045 ELSE IF OPERTRI = '-' 00008145 SUBTRACT PAR2 FROM PAR1 GIVING NUMNUM 00008245 ELSE IF OPERTRI = '+' 00008346 ADD PAR1 PAR2 GIVING NUMNUM. 00008445 * 00008545 MOVE NUMTXT TO R-RES 00008645 EXAMINE R-RES REPLACING LEADING '0' BY ' ' 00008745 MOVE OPERTRI TO R-TOP 00008845 MOVE RESULT TO RESULTO. 00008945 * 00009045 EXEC KICKS 00009138 SEND MAP('RRPCMAP') 00009238 MAPSET('TESTMSD') 00009338 DATAONLY 00009438 END-EXEC. 00009538 00009638 MOVE PARAM1I TO C-PARAM1. 00009735 MOVE PARAM2I TO C-PARAM2. 00009834 MOVE OPERTRI TO C-OPERTR. 00009934 EXEC KICKS 00010034 RETURN TRANSID('RRPC') 00010134 COMMAREA(MYCOMMAREA) 00010235 END-EXEC. 00010334 /* 00010404 //LKED.SYSIN DD * 00010504 INCLUDE SKIKLOAD(KIKCOBGL) 00010604 ENTRY RRPCALC 00010732 NAME RRPCALC(R) 00010832