midrange.com code scratchpad
Name:
Jack Tucky
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
03/12/2014 01:37:48 am
IP:
Logged
Description:
CSV Changed to accept a field instead of processing an IFS file
Code:
  1. CSV_H5
  2. /if defined(CSV_H5_DEFINED)  
  3. /eof                         
  4. /endif                       
  5. /define CSV_H5_DEFINED       
  6. D CSV_getfldX     PR             1N   extproc(*CL:'CSV_GETFLDX') 
  7. D   peData                   65502A   varying                    
  8. D   peFldData                65502A   varying options(*varsize)  
  9. D   peVarSize                   10I 0 value                      
  10.  
  11. CSVDEMO5
  12. H DFTACTGRP(*NO) ACTGRP(*CALLER) BNDDIR('CSV5')            
  13.                                                            
  14.  /copy CSV_H5                                              
  15.                                                            
  16. D acct            s              4s 0                      
  17. D temp            s              4a   varying              
  18. D name            s             30a   varying              
  19. D addr            s             30a   varying              
  20. D city            s             15a   varying              
  21. D state           s              2a   varying              
  22.                                                            
  23. D peFldData       s          65502A   varying              
  24. D fc              s             10i 0                      
  25. D fld             s            132a   varying              
  26.                                                            
  27.  /free                                                     
  28.                                                        
  29.    peFldData = '1,"Art T","123 main","jackson","NJ"';  
  30.                                                        
  31.         CSV_getfldX(peFldData: temp:  %size(temp));    
  32.         CSV_getfldX(peFldData: name:  %size(name));    
  33.         CSV_getfldX(peFldData: addr:  %size(addr));    
  34.         CSV_getfldX(peFldData: city:  %size(city));    
  35.         CSV_getfldX(peFldData: state: %size(state));   
  36.         acct = %dec( temp: 4: 0);                      
  37.                                                        
  38.                                                        
  39.      *inlr = *on;                                      
  40.                                                        
  41.  /end-free                                             
  42.                                                        
  43.  
  44. CSVR5
  45. H NOMAIN OPTION(*SRCSTMT: *NOSHOWCPY) BNDDIR('QC2LE')        
  46.                                                              
  47.  /copy bufio_h                                               
  48.  /copy csv_h5                                                
  49.                                                              
  50. D VARPREF         C                   2                      
  51. D LINEFEED        C                   X'25'                  
  52. D CARRTN          C                   X'0D'                  
  53.                                                              
  54. D    fp           s               *           inz(*NULL)     
  55. D    buf          s          65502A   varying inz('')        
  56. D    bufpos       s             10I 0         inz(0)         
  57. D    flddel       s              1A           inz(',')       
  58. D    strdel1      s              1A           inz('"')       
  59. D    strdel2      s              1A           inz('''')               
  60.                                                                       
  61. D ReportError     PR                                                  
  62. D   peMsg                      256a   varying const                   
  63. D                                     options(*varsize:*nopass:*omit) 
  64. P CSV_getfldX     B                   export                       
  65. D CSV_getfldX     PI             1N                                
  66. D   buf                      65502A   varying                      
  67. D   peFldData                65502A   varying options(*varsize)    
  68. D   peVarSize                   10I 0 value                        
  69.                                                                    
  70. D UNQUOTED        C                   0                            
  71. D QUOTED          C                   1                            
  72. D ENDQUOTE        C                   2                            
  73.                                                                    
  74.                                                                    
  75. D state           s             10i 0 inz(UNQUOTED)                
  76. D max             s             10I 0                              
  77. D len             s             10I 0                              
  78. D start           s             10I 0                              
  79. D pos             s             10I 0                              
  80. D char            s              1A   based(p_char)                
  81. D qchar           s              1A                         
  82.                                                             
  83.  /free                                                      
  84.                                                             
  85.     max = peVarSize - VARPREF;                              
  86.     len = %len(buf) -1 ;                                    
  87.     start = bufpos;                                         
  88.     %len(peFldData) = 0;                                    
  89.                                                             
  90.     if (start > len);                                       
  91.         return *OFF;                                        
  92.     endif;                                                  
  93.                                                             
  94.     for pos = start to len;                                 
  95.                                                             
  96.         p_char = %addr(buf) + VARPREF + pos;                
  97.  
  98.         select;                                       
  99.         when state = UNQUOTED;                        
  100.                                                       
  101.            select;                                    
  102.            when char = flddel;                        
  103.               leave;                                  
  104.            when char = strdel1                        
  105.              or char = strDel2;                       
  106.               state = QUOTED;                         
  107.               qchar = char;                           
  108.            when %len(peFldData) < max;                
  109.               peFldData += char;                      
  110.            endsl;                                     
  111.                                                       
  112.         when state = QUOTED;                          
  113.                                                       
  114.             select;                                   
  115.             when char = qchar;                                   
  116.                state = ENDQUOTE;                                 
  117.             when %len(peFldData) < max;                          
  118.                peFldData += char;                                
  119.             endsl;                                               
  120.                                                                  
  121.         when state = ENDQUOTE;                                   
  122.                                                                  
  123.            select;                                               
  124.            when char = qchar;                                    
  125.                state = QUOTED;                                   
  126.                if (%len(peFldData) < max);                       
  127.                   peFldData += char;                             
  128.                endif;                                            
  129.            when char = flddel;                                   
  130.                leave;                                            
  131.            when char = strdel1                                   
  132.              or char = strDel2;                         
  133.                state = QUOTED;                          
  134.                qchar = char;                            
  135.            when %len(peFldData) < max;                  
  136.                state = UNQUOTED;                        
  137.                peFldData += char;                       
  138.            endsl;                                       
  139.                                                         
  140.         endsl;                                          
  141.                                                         
  142.     endfor;                                             
  143.                                                         
  144.     bufpos = pos + 1;                                   
  145.     return *ON;                                         
  146.  /end-free                                              
  147. P                 E                                     
  148. P ReportError     B                                                   
  149. D ReportError     PI                                                  
  150. D   peMsg                      256a   varying const                   
  151. D                                     options(*varsize:*nopass:*omit) 
  152.                                                                       
  153. D my_errno_func   PR              *   ExtProc('__errno')              
  154.  D my_errno        s             10I 0 based(p_my_errno)                
  155.                                                                         
  156.  D QMHSNDPM        PR                  ExtPgm('QMHSNDPM')               
  157.  D   MessageID                    7A   Const                            
  158.  D   QualMsgF                    20A   Const                            
  159.  D   MsgData                  32767A   Const options(*varsize)          
  160.  D   MsgDtaLen                   10I 0 Const                            
  161.  D   MsgType                     10A   Const                            
  162.  D   CallStkEnt                  10A   Const                            
  163.  D   CallStkCnt                  10I 0 Const                            
  164.  D   MessageKey                   4A                                    
  165.  D   ErrorCode                32767A   options(*varsize)                
  166.                                                                         
  167.  D ErrorCode       DS                  qualified                        
  168.  D  BytesProv                    10I 0 inz(0)                           
  169.  D  BytesAvail                   10I 0 inz(0)                           
  170. D MsgKey          S              4A                              
  171. D MsgID           s              7A                              
  172. D MsgDta          s            256a   varying                    
  173.                                                                  
  174.  /free                                                           
  175.                                                                  
  176.     if  %parms>=1 and %addr(peMsg)<>*null;                       
  177.        MsgId = 'CPF9897';                                        
  178.        MsgDta = peMsg;                                           
  179.     else;                                                        
  180.        p_my_errno = my_errno_func();                             
  181.        MsgID = 'CPE' + %editc( %dec(my_errno:4:0) : 'X' );       
  182.        %len(MsgDta) = 0;                                         
  183.     endif;                                                       
  184.                                                                  
  185.     QMHSNDPM( MsgID                                              
  186.             : 'QCPFMSG   *LIBL'                                  
  187.             : MsgDta                             
  188.             : %len(MsgDta)                       
  189.             : '*ESCAPE'                          
  190.             : '*PGMBDY'                          
  191.             : 1                                  
  192.             : MsgKey                             
  193.             : ErrorCode         );               
  194.                                                  
  195.  /end-free                                       
  196. P                 E                                                                                                    
  197.                                                                       
© 2004-2019 by midrange.com generated in 0.008s valid xhtml & css