i tried a way to do using the selcopy manual and figured a way out but i dont know whether this is the right way
my requirement was to do the cvpc operation (selcopy) in rexx and also the CVCP operation in rexx
i wanted the equivalent cvpc to get me the cooresponding character for the packed decimel for operations in REXX and cvcp to store the value as packed decimel
i wrote the following code can someone review the code to give me your valuable suggestions.
code for cvpc
/*REXX*/
/*VARS IS VALUE LENS IS THE LENGTH OF SOURCE LEND IS THE DEST LENGTH*/
VARS= '130N'
LENS= 4
LEND= 3
CALL CVpcREXX
SAY "'"VARD"'"
EXIT
CVpcREXX:
/*CHECK FOR MORE THAN ONE CHARACTER AT THE END*/
IF (C2D(SUBSTR(VARS,LENS-1,1)) < C2D('0') & C2D(SUBSTR(VARS,LENS-1,1))>C2D('9'),
& C2D(SUBSTR(VARS,LENS,1)) <C2D('0') & C2D(SUBSTR(VARS,LENS,1)) >C2D('9'))
THEN
DO
TEMPSIGN = '+'
END
/*CHECK THE LAST CHARACTER TO SUBSTITUTE*/
IF ( C2D(SUBSTR(VARS,LENS-1,1)) >= 240 & C2D(SUBSTR(VARS,LENS-1,1)) <= 249) THEN
DO
IF C2D(SUBSTR(VARS,LENS,1)) < 240 ! C2D(SUBSTR(VARS,LENS,1)) > 249 THEN
DO
IF C2D(SUBSTR(VARS,LENS,1)) >= 209 & C2D(SUBSTR(VARS,LENS,1))<= 217 THEN
DO
TEMPSIGN = '-'
VARS=VARS !! TRANSLATE(SUBSTR(VARS,LENS,1),'123456789','JKLMNOPQR')
END
IF C2D(SUBSTR(VARS,LENS,1)) >= 193 & C2D(SUBSTR(VARS,LENS,1))<= 201 THEN
DO
TEMPSIGN = '+'
VARS=VARS !! TRANSLATE(SUBSTR(VARS,LENS,1),'123456789','ABCDEFGHI')
END
END
END
/*CHECK SIGN AT THE RIGHT MOST POSITION*/
TEMP1 = SUBSTR(VARS,1,1)
IF TEMP1='+' THEN
TEMPSIGN='+'
IF TEMP1='-' THEN
TEMPSIGN='-'
/*REMOVE ALL THE SYMBOLS*/
VARS=SPACE(TRANSLATE(VARS,' ','ABCDEFGHIJKLMNOPQRSTUVWXYZ'),0)
VARS=SPACE(TRANSLATE(VARS,' ','`~!@#$%^&*()_+-= \}{][:;/.,'),0)
/*PUT THE SIGN*/
VARD=SPACE(RIGHT(VARS,LEND),0)
VARD=TEMPSIGN!!VARD
RETURN
code for cvcp
/*REXX*/
VARS= -195
LEND=2
CALL CVcpREXX
SAY VARD
EXIT
CVcpREXX:
TEMP2=ABS(VARS //10)
IF VARS < 0 THEN
TEMP3='D'
ELSE
TEMP3='F'
TEMP3=TEMP3!!TEMP2
VARD=ABS(VARS%10)
VARD=RIGHT(VARD,LEND-1)
VARD=VARD!!X2C(TEMP3)
RETURN