Thanks for all the advice. I'm still testing, but it appears that
the following is going to work for me. You'll notice that this performed
routine doesn't reapply the negative sign. Sometimes I want to retain the
original sign and sometimes I don't. So, the points from where this
routine is performed make the decision as to whether to reapply any
negative sign that may be needed or even force a x'F' sign.
* =================================================================== *
PPACKVAR DS 0H PARSE&&PACK ZONED DECIMAL STRING WITH ALIGNMENT
* ------------------------------------------------------------------- *
* COMPUTE ALIGNMENT NEEDED (IF ANY)
LLC R0,=X'4B' SEARCH FOR DECIMAL POINT
LA R1,VARDATA POINT TO KEY DATA SOURCE
L R2,SHVVALL SET LENGTH OF VAR DATA
LA R3,0(R2,R1) POINT TO SEARCH ENDING
LR R4,R3 AND SAVE THAT ADDRESS
IF R3,(NM,SRST),R1 IF NO MATCH ON DECIMAL POINT
L R4,KEY_DECM GET DECIMAL ALIGNMENT NEEDED
ELSE ELSE
SHI R2,1 MINUS 1 FOR DECIMAL POINT
ST R2,SHVVALL REPLACE LENGTH OF VAR DATA
SR R4,R3 COMPUTE REMAINING LENGTH
LA R1,1(,R3) POINT TO CHAR AFTER DECIMAL
LR R2,R4 COPY REMAINING LENGTH VALUE
SHI R2,1 DECREMENT BEFORE EXECUTE
EX R2,ADJUST_IT REMOVE DECIMAL POINT
IF R2,(EQ,C),KEY_DECM IF ENOUGH DECIMALS FOUND
XR R4,R4 NO ALIGNMENT NEEDED
ELSE ELSE
IF R2,(LT,C),KEY_DECM IF TOO FEW DECIMALS FOUND
L R4,KEY_DECM GET DECIMALS WANTED
SR R4,R2 CALC. DECIMALS NEEDED
ELSE ELSE TOO MANY DECIMALS FOUND
S R2,KEY_DECM CALC. DECIMALS TO REMOVE
L R4,SHVVALL GET LENGTH OF VAR DATA
SR R4,R2 REMOVE EXTRA DECIMALS
ST R4,SHVVALL REPLACE WITH NEW LENGTH
XR R4,R4 AND NO ALIGNMENT NEEDED
ENDIF ENDIF
ENDIF ENDIF
ENDIF ENDIF
* PACK AND ALIGN THE DATA
LA R1,VARDATA POINT TO KEY DATA SOURCE
L R2,SHVVALL SET LENGTH OF VAR DATA
IF VARDATA,EQ,C'-',OR,VARDATA,EQ,C'+'
AHI R1,1 SKIP SIGN BYTE
SHI R2,1 AND REDUCE LENGTH
ENDIF
SHI R2,1 DECREMENT BEFORE EXECUTE
EX R2,PACK_IT PACK VAR DATA INTO WORK FLD
WHILE R4,(NZ,LTR),R4 LOOP ON ALIGNMENT NEEDED
MP PWORK16,=P'10' ADD 1 DECIMAL PLACE
SHI R4,1 DECR. DECIMALS NEEDED
WEND LOOP ON ALIGNMENT NEEDED
* ------------------------------------------------------------------- *
BR R5 RETURN TO CALLER
ADJUST_IT MVC 0(0,R3),0(R1) (SEE FIRST "EX" INSTR. ABOVE)
PACK_IT PKA PWORK16,0(0,R1) (SEE SECOND "EX" INSTR. ABOVE)
* =================================================================== *
Sincerely,
Dave Clark
--
int.ext: 91078
direct: (937) 531-6378
home: (937) 751-3300
Winsupply Group Services
3110 Kettering Boulevard
Dayton, Ohio 45439 USA
(937) 294-5331
*********************************************************************************************
This email message and any attachments is for use only by the named
addressee(s) and may contain confidential, privileged and/or proprietary
information. If you have received this message in error, please
immediately notify the sender and delete and destroy the message and all
copies. All unauthorized direct or indirect use or disclosure of this
message is strictly prohibited. No right to confidentiality or privilege
is waived or lost by any error in transmission.
*********************************************************************************************
