H DFTACTGRP(*NO) BNDDIR('ERPGSDK')                                                             
      **********************************************************************                        
     FCART1     UF A E           K DISK    USROPN                                                   
      **********************************************************************                        
      * Prototypes                                                   *                              
      ****************************************************************                              
      /COPY QCOPYSRC,P.ERPGSDK                                                                      
      /COPY QCOPYSRC,P.STRING                                                                       
      ****************************************************************                              
     D DftPath         S             64    INZ('/www/erpgsdk/catalog+                               
     D                                          /templates/')                                       
      *                                                                                             
      * Data read in from Web Page                                                                  
     D user            S             30                                                             
     D prod            S             15                                                             
     D qty             S              9  0                                                          
     D addqty          S              9  0                                                          
      *                                                                                             
      * Work variables                                                                              
     D ProdArr         S             12    DIM(9999)                                                
     D QtyArr          S              9  0 DIM(9999)                                                
     D AddQtyArr       S              9  0 DIM(9999)                                                
      *                                                                                             
     D ProdKey         S                   Like(Prod)                                               
     D ProdCount       S             10i 0                                                          
     D i               S             10i 0                                                          
      **********************************************************************                        
     C                   callp     #startup                                                         
      *                                                                                             
     C                   EXSR      $Input                                                           
     C                   callp     #setPath(DftPath)                                                
      *                                                                                             
     C                   if        (user <> ' ')                                                    
     C                   EXSR      $Main                                                            
     C                   else                                                                       
     C                   EXSR      $Signon                                                          
     C                   endif                                                                      
      *                                                                                             
     C                   callp     #cleanup                                                         
      *                                                                                             
     C                   SETON                                        LR                            
      ****************************************************************                              
      * Main Display                                                 *                              
      ****************************************************************                              
     C     $Main         BEGSR                                                                      
      *                                                                                             
     C                   callp     #loadTemplate('addcart.erpg')                                    
     C                   EXSR      $First                                                           
      *                                                                                             
     C                   ENDSR                                                                      
      ****************************************************************                              
      * Redirect to Signon                                           *                              
      ****************************************************************                              
     C     $Signon       BEGSR                                                                      
      *                                                                                             
     C                   callp     #loadTemplate('redsignon.erpg')                                  
     C                   callp     #writeThisSec('first')                                           
      *                                                                                             
     C                   ENDSR                                                                      
      ****************************************************************                              
      * First                                                        *                              
      ****************************************************************                              
     C     $First        BEGSR                                                                      
      *                                                                                             
     C                   OPEN      CART1                                99                          
      *                                                                                             
     C                   if        (not *IN99)                                                      
      *                                                                                             
     C                   do        ProdCount     i                                                  
     C                   eval      ProdKey = ProdArr(i)                                             
     C     CartKey       CHAIN     CART1                                                            
      *                                                                                             
     C                   if        (not %found(CART1))                                              
     C                   CLEAR     *ALL          RCART                                              
     C                   eval      SCUSER = user                                                    
     C                   eval      SCPROD = ProdArr(i)                                              
     C                   endif                                                                      
      *                                                                                             
     C                   if        (AddQtyArr(i) > 0)                                               
     C                   eval      SCQTY = (SCQTY + AddQtyArr(i))                                   
     C                   else                                                                       
     C                   eval      SCQTY = QtyArr(i)                                                
     C                   endif                                                                      
      *                                                                                             
     C                   if        (not %found(CART1))                                              
     C                   WRITE     RCART                                                            
     C                   else                                                                       
      *                                                                                             
     C                   if        (SCQTY <= 0)                                                     
     C                   DELETE    RCART                                                            
     C                   else                                                                       
     C                   UPDATE    RCART                                                            
     C                   endif                                                                      
      *                                                                                             
     C                   endif                                                                      
      *                                                                                             
     C                   enddo                                                                      
      *                                                                                             
     C                   callp     #loadSection('first')                                            
     C                   callp     #replaceData('/%message%/':'Cart Updated')                       
     C                   else                                                                       
     C                   callp     #replaceData('/%message%/':                                      
     C                                          'Error opening File!')                              
     C                   endif                                                                      
      *                                                                                             
     C                   callp     #writeSection                                                    
      *                                                                                             
     C                   ENDSR                                                                      
      ****************************************************************                              
      * Read Input from web page                                     *                              
      ****************************************************************                              
     C     $Input        BEGSR                                                                      
      *                                                                                             
     C                   eval      user = #getCookie('user')                                        
      *                                                                                             
     C                   eval      i = 1                                                            
     C                   eval      prod = #getData('prod':i)                                        
      *                                                                                             
     C                   dow       (prod <> ' ')                                                    
     C                   eval      ProdCount = (ProdCount + 1)                                      
     C                   eval      ProdArr(ProdCount) = prod                                        
     C                   eval      qty = #CtoN(#getData('qty':i))                                   
      *                                                                                             
     C                   if        (qty <= 0)                                                       
     C                   eval      qty = 0                                                          
     C                   endif                                                                      
      *                                                                                             
     C                   eval      QtyArr(ProdCount) = qty                                          
      *                                                                                             
     C                   eval      addqty = #CtoN(#getData('addqty':i))                             
      *                                                                                             
     C                   if        (addqty <= 0)                                                    
     C                   eval      addqty = 0                                                       
     C                   endif                                                                      
      *                                                                                             
     C                   eval      AddQtyArr(ProdCount) = addqty                                    
      *                                                                                             
     C                   eval      i = (i + 1)                                                      
     C                   eval      prod = #getData('prod':i)                                        
     C                   enddo                                                                      
      *                                                                                             
     C                   eval      prod = #getData('prod')                                          
      *                                                                                             
     C                   ENDSR                                                                      
      ****************************************************************                              
      * Initialization Subroutine                                    *                              
      ****************************************************************                              
     C     *INZSR        BEGSR                                                                      
      *                                                                                             
     C     CartKey       KLIST                                                                      
     C                   KFLD                    user                                               
     C                   KFLD                    ProdKey                                            
      *                                                                                             
     C                   ENDSR