/* REXX */                                                                      
NUMERIC DIGITS 31                                                               
PARSE SOURCE . . . . zdsn .                                                     
                                                                                
/* Executed as a Command. */                                                    
ADDRESS TSO "EXEC '"zdsn"(C2PD)' '10000 3' EXEC"                                
SAY                                                                             
                                                                                
/* Subroutine calls - all results displayed by C2PD.           */               
CALL C2PD                /* No value passed.                   */               
SAY RESULT                                                                      
CALL C2PD A123           /* Invalid zoned decimal number.      */               
SAY RESULT                                                                      
CALL C2PD 1233 a         /* Invalid length.                    */               
SAY RESULT                                                                      
CALL C2PD 1233 3.2       /* Length not a whole number.         */               
SAY RESULT                                                                      
CALL C2PD 1233 2         /* Length too small for value.        */               
SAY RESULT                                                                      
                                                                                
x = MSG('OFF')                                                                  
ADDRESS TSO "DELETE REXXA.C2PD"                                                 
x = MSG('ON')                                                                   
SIGNAL ON ERROR                                                                 
ADDRESS TSO "ALLOCATE F(C2PD) DA(REXXA.C2PD) NEW CATALOG",                      
            "UNIT(SYSDA) SPACE(1 1) TRACK",                                     
            "DSORG(PS) RECFM(F B) LRECL(100) BLKSIZE(0)"                        
                                                                                
/* Subroutine calls - trap output to write records.            */               
x = OUTTRAP('ztrap.','*','NOCONCAT')                                            
CALL C2PD '+34 6'        /* Positive number to 6-bytes.        */               
QUEUE ztrap.2                                                                   
x = OUTTRAP('ztrap.','*','NOCONCAT')                                            
CALL C2PD -34 6          /* Negative number to 6-bytes.        */               
QUEUE ztrap.2                                                                   
x = OUTTRAP('ztrap.','*','NOCONCAT')                                            
CALL C2PD 123 6          /* Unsigned number to 6-bytes.        */               
QUEUE ztrap.2                                                                   
x = OUTTRAP('ztrap.','*','NOCONCAT')                                            
CALL C2PD -1234567890    /* Even number of digits to 6-bytes.  */               
QUEUE ztrap.2                                                                   
x = OUTTRAP('ztrap.','*','NOCONCAT')                                            
CALL C2PD '+12345678912' /* Odd number of digits to 6-bytes.   */               
QUEUE ztrap.2                                                                   
                                                                                
/* Function calls - only result returned from B2C.             */               
QUEUE LEFT(C2PD(0 6),80) /* Zero to 6-bytes.                   */               
QUEUE LEFT(C2PD(1 6),80) /* Unsigned 1 to 6-bytes.             */               
                                                                                
QUEUE ''  /* End of file. */                                                    
ADDRESS TSO "EXECIO * DISKW C2PD (FINIS)"                                       
SIGNAL OFF ERROR                                                                
                                                                                
Error:                                                                          
ADDRESS TSO "FREE F(C2PD)"                                                      
                                                                                
EXIT 0