0001.00 /* ***************************************************************** */ 
0002.00 /*        MOD#: CWH1102                     DATE: 04/02/03           */ 
0003.00 /*                                                                   */ 
0004.00 /*        PROGRAM-ID: CRR001C                                        */ 
0005.00 /*                                                                   */ 
0006.00 /*        PURPOSE: To run queries and "push" the output to the       */ 
0007.00 /*                 IFS as a CSV file.                                */ 
0008.00 /*                                                                   */ 
0010.00 /* ***************************************************************** */ 
0011.00              PGM        PARM(&XQRYNM &XQRYLB &X@DEVD &X@FRDT &X@TODT)   
0012.00              DCL        VAR(&XQRYNM) TYPE(*CHAR) LEN(10)                
0013.00              DCL        VAR(&XQRYLB) TYPE(*CHAR) LEN(10)                
0014.00              DCL        VAR(&X@DEVD) TYPE(*CHAR) LEN(10)                
0015.00              DCL        VAR(&X@FRDT) TYPE(*CHAR) LEN(8)                 
0016.00              DCL        VAR(&X@TODT) TYPE(*CHAR) LEN(8)                 
0017.00 /* 1. Declare the IFS File Name Variables.                           */ 
0018.00              DCL        VAR(&XXTONM1) TYPE(*CHAR) LEN(5) +             
0019.00                           VALUE('RPTS/')                        
0020.00              DCL        VAR(&XXTONM2) TYPE(*CHAR) LEN(11) +             
0021.00                           VALUE('/QUERY1.CSV')                          
0022.00              DCL        VAR(&XXTONM22) TYPE(*CHAR) LEN(11) +            
0023.00                           VALUE('/FLAG.TXT')                            
0024.00              DCL        VAR(&XXTONM3) TYPE(*CHAR) LEN(50)               
0025.00              DCL        VAR(&XXTONM32) TYPE(*CHAR) LEN(50)              
0026.00              BEXCLL BASE                                                
0027.00 /* 2. Did the Device Name come across as blank?                      */ 
0028.00            IF         COND(&X@DEVD = '          ') THEN(DO)             
0029.00              CHGVAR     VAR(&X@DEVD) VALUE('ERROR')                     
0030.00            ENDDO                                                        
0031.00 /* 3. Put together the copy To Name Variables.                       */ 
0032.00              CHGVAR     VAR(&XXTONM3) VALUE(&XXTONM1 *TCAT &X@DEVD +    
0033.00                           *TCAT &XXTONM2)                               
0034.00              CHGVAR     VAR(&XXTONM32) VALUE(&XXTONM1 *TCAT &X@DEVD +   
0035.00                           *TCAT &XXTONM22)                              
0036.00 /* 4. Delete previous IFS file if there is one.                      */ 
0037.00              DEL        OBJLNK(&XXTONM3)                                
0038.00              MONMSG     MSGID(CPFA0A9)                                  
0039.00 /* 5. Copy the Header to the appropriate IFS folder.                 */ 
0040.00              CPY        OBJ('/RPTS/HEADERS/QUERY1.CSV') +        
0041.00                           TOOBJ(&XXTONM3) DTAFMT(*TEXT) REPLACE(*YES)   
0042.00              MONMSG     MSGID(CPFA0B1)                                  
0043.00 /* 6. Delete the query output file from the last run, if there.      */ 
0044.00              DLTF       FILE(QTEMP/CRROUTP)                             
0045.00              MONMSG     MSGID(CPF0000)                                  
0046.00              MONMSG     MSGID(CPF9999)                                  
0047.00 /* 7. Call the program to update the Query Date Reference file.      */ 
0048.00              DLTF       FILE(QTEMP/CRRDATP)                             
0049.00              MONMSG     MSGID(CPF0000 CPF9999)                          
0050.00              CRTDUPOBJ  OBJ(CRRDATP) FROMLIB(BSYDTAD) OBJTYPE(*FILE) +  
0051.00                           TOLIB(QTEMP) DATA(*YES)                       
0052.00              OVRDBF     FILE(CRRDATP) TOFILE(QTEMP/CRRDATP)             
0053.00              CALL       PGM(CRR001R) PARM(&X@FRDT &X@TODT)              
0054.00 /* 8. Run the query and output to a physical file.                   */ 
0055.00              RUNQRY     QRY(&XQRYLB/&XQRYNM) OUTTYPE(*OUTFILE) +        
0056.00                           OUTFILE(QTEMP/CRROUTP)                        
0057.00 /*    A. Query Not Found?                                            */ 
0058.00              MONMSG     MSGID(QRY0000 QRY9999) EXEC(DO)                 
0059.00              CPY        OBJ('/RPTS/HEADERS/QUERYNT.CSV') +       
0060.00                           TOOBJ(&XXTONM3) DTAFMT(*TEXT) REPLACE(*YES)   
0061.00              CHGAUT     OBJ(&XXTONM3) USER(*PUBLIC) DTAAUT(*RWX) +      
0062.00                           OBJAUT(*ALL)                                  
0063.00              CPY        OBJ('/RPTS/HEADERS/FLAG.TXT') +          
0064.00                           TOOBJ(&XXTONM32) +                            
0065.00                           DTAFMT(*TEXT) REPLACE(*YES)                   
0066.00              GOTO       CMDLBL(ENDER)                                   
0067.00            ENDDO                                                        
0068.00              DLTOVR     FILE(CRRDATP)                                   
0069.00 /* 9. Copy the Physical file to the IFS as a CSV.                    */ 
0070.00              CPYTOIMPF  FROMFILE(QTEMP/CRROUTP *FIRST) +                
0071.00                           TOSTMF(&XXTONM3) +                            
0072.00                           MBROPT(*ADD) STMFCODPAG(437) RCDDLM(*CRLF)    
0073.00              MONMSG     MSGID(CPFA0B1)                                  
0074.00 /* 10. Change the authority so it can be used.                       */ 
0075.00              CHGAUT     OBJ(&XXTONM3) +                                 
0076.00                           USER(*PUBLIC) DTAAUT(*RWX) OBJAUT(*ALL)       
0077.00 /* 11. Copy Flag.txt so Excel "knows" the CSV file is there.         */ 
0078.00              CPY        OBJ('/RPTS/HEADERS/FLAG.TXT') +          
0079.00                           TOOBJ(&XXTONM32) +                            
0080.00                           DTAFMT(*TEXT) REPLACE(*YES)                   
0081.00  ENDER:      ENDPGM