/* SPLRTVSPLC - Spool retrieved spooled file from user space     */             
/*              CPP of SPLRTVSPLF                                */             
                                                                                
             PGM        PARM(&FULLUSRSPC &FULLOUTQ)                             
                                                                                
             DCL        &FILE *CHAR LEN(10)                                     
             DCL        &FULLOUTQ *CHAR LEN(20)                                 
             DCL        &FULLUSRSPC *CHAR LEN(20)                               
             DCL        &OUTQ *CHAR LEN(10)                                     
             DCL        &OUTQL *CHAR LEN(10)                                    
             DCL        &USRSPC *CHAR LEN(10)                                   
             DCL        &USRSPCL *CHAR LEN(10)                                  
             DCL        &INTJOB *CHAR LEN(16)                                   
             DCL        &INTSPLF *CHAR LEN(16)                                  
             DCL        &SPLHANDL *CHAR LEN(4)                                  
             DCL        &DS *CHAR LEN(5000) /*Spooled file attributes*/         
             DCL        &DSLENB *CHAR LEN(4)                                    
             DCL        &ERRCDE *CHAR LEN(4)                                    
             DCL        &STRPOS *CHAR LEN(4)                                    
             DCL        &LEN *CHAR LEN(4)                                       
                                                                                
 /* SPOOL BUFFER SIZE ON SPLINFO OFFSET 861*/                                   
             DCL        &SPLBUFSIZC *CHAR LEN(4)                                
             DCL        &SPLBUFSIZ  *DEC  LEN(9 0)                              
 /* NUMBER OF BUFFER  ON SPLINFO OFFSET 997*/                                   
             DCL        &NUMOFBUFC  *CHAR LEN(4)                                
             DCL        &NUMOFBUF   *DEC  LEN(9 0)                              
             DCL        &BIN4       *char len(4)                                
             DCL        &BIN4NBR    *DEC  LEN(9 0)                              
                                                                                
             DCL        &ERRORSW *LGL                     /* Std err */         
             DCL        &MSGID *CHAR LEN(7)               /* Std err */         
             DCL        &MSGDTA *CHAR LEN(256)            /* Std err */         
             DCL        &MSGF *CHAR LEN(10)               /* Std err */         
             DCL        &MSGFLIB *CHAR LEN(10)            /* Std err */         
             DCL        &KEYVAR *CHAR LEN(4)              /* Std err */         
                                                                                
             MONMSG     MSGID(CPF0000) EXEC(GOTO STDERR1) /* Std err */         
                        /* Inlz fields */                                       
             CHGVAR     &ERRCDE X'00000000'                                     
                                                                                
                        /* Extract qualified names */                           
                        /* Check user space */                                  
             CHGVAR     &USRSPC  %SST(&FULLUSRSPC 1 10)                         
             CHGVAR     &USRSPCL  %SST(&FULLUSRSPC 11 10)                       
             CHKOBJ     OBJ(&USRSPCL/&USRSPC) OBJTYPE(*USRSPC)                  
                                                                                
                        /* Check output queue */                                
             CHGVAR     &OUTQ  %SST(&FULLOUTQ 1 10)                             
             CHGVAR     &OUTQL  %SST(&FULLOUTQ 11 10)                           
             IF         (&OUTQ *NE '*SAVOUTQ') DO                               
             CHKOBJ     OBJ(&OUTQL/&OUTQ) OBJTYPE(*OUTQ)                        
             ENDDO      /* Check output queue */                                
                                                                                
             IF         (&OUTQ *NE '*SAVOUTQ') DO                               
                        /* If OUTQL is *LIBL, get actual name */                
             IF         (&OUTQL *EQ '*LIBL') DO /* *LIBL used */                
             RTVOBJD    OBJ(&OUTQL/&OUTQ) OBJTYPE(*OUTQ) RTNLIB(&OUTQL)         
             ENDDO      /* *LIBL used */                                        
             ENDDO      /* Output queue named */                                
                                                                                
      /* Retrieve user space size and extract spooled attributes*/              
             CHGVAR     %BIN(&LEN 1 4) 4                                        
             CHGVAR     %BIN(&STRPOS 1 4) 89                                    
             CALL       QUSRTVUS PARM(&FULLUSRSPC &STRPOS &LEN &BIN4)           
             CHGVAR     &BIN4NBR %BIN(&BIN4)                                    
             CHGVAR     &BIN4NBR (&BIN4NBR + 1)                                 
             CHGVAR     %BIN(&STRPOS 1 4) &BIN4NBR                              
             CHGVAR     %BIN(&LEN 1 4) 5000                                     
             CALL       QUSRTVUS PARM(&FULLUSRSPC &STRPOS &LEN &DS)             
                                                                                
             IF         (&OUTQ *NE '*SAVOUTQ') DO                               
             CHGVAR     %SST(&DS 191 20) &FULLOUTQ                              
             ENDDO      /* Output queue named */                                
             ELSE DO                                                            
             CHGVAR     &OUTQ  %SST(&DS 191 10)                                 
             CHGVAR     &OUTQL %SST(&DS 201 10)                                 
             ENDDO                                                              
                                                                                
             CHGVAR     &FILE  %SST(&DS 75 10)                                  
                                                                                
             SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) TOPGMQ(*EXT) +             
                          MSGDTA('Retrieving the spooled +                      
                          file ' *CAT &FILE ) MSGTYPE(*STATUS)                  
                                                                                
                        /* Call API to create spooled file */                   
             CALL       QSPCRTSP PARM(&SPLHANDL  &DS &ERRCDE)                   
                                                                                
 PUTRCD:                /* Call API to put spooled records */                   
             CALL       QSPPUTSP PARM(&SPLHANDL  &USRSPC &ERRCDE)               
                                                                                
 CLOSE:                 /* Call API to close spooled output file */             
             CALL       QSPCLOSP PARM(&SPLHANDL  &ERRCDE)                       
                                                                                
             SNDPGMMSG  MSGID(CPI9801) MSGF(QCPFMSG) TOPGMQ(*EXT) +             
                          MSGTYPE(*STATUS) /* Blank status message */           
             SNDPGMMSG  MSG('Spool file ' *CAT &FILE  *TCAT ' +                 
                          printed as file ' *CAT &FILE    +                     
                          *TCAT ' to output queue ' *CAT +                      
                          &OUTQ *TCAT ' in ' *CAT &OUTQL +                      
                          *TCAT '.') +                                          
                          MSGTYPE(*COMP)                                        
             RMVMSG     CLEAR(*ALL)                                             
             RETURN     /* Normal end of program */                             
 STDERR1:               /* Standard error handling routine */                   
             IF         &ERRORSW SNDPGMMSG MSGID(CPF9999) +                     
                          MSGF(QCPFMSG) MSGTYPE(*ESCAPE) /* Func chk */         
             CHGVAR     &ERRORSW '1' /* Set to fail if error occurs */          
 STDERR2:    RCVMSG     MSGTYPE(*DIAG) RMV(*NO) KEYVAR(&KEYVAR) +               
                          MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +           
                          SNDMSGFLIB(&MSGFLIB)                                  
             IF         (&KEYVAR *EQ '    ') GOTO STDERR3                       
             RMVMSG     MSGKEY(&KEYVAR)                                         
             SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +                    
                          MSGDTA(&MSGDTA) MSGTYPE(*DIAG)                        
             GOTO       STDERR2 /* Loop back for addl diagnostics */            
 STDERR3:    RCVMSG     MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +          
                          MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB)                      
             SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +                    
                          MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)                      
             ENDPGM                                                             
